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EARTH RESOURCES DATA PROCESSOR 

M. R. Phillips 
IIT Research Institute 

SUMMARY 

During the past several months and since the inception of 
the Flight Data Statistics Office, a growing trend to analyze 
and process Earth Resources Flight Data has prevailed. In view 
of the growing interest at Marshall Space Flight Center to or- 
ganize and establish capabilities to perform research studies 
in this area, endeavors in the areas of interpretation, analysis, 
and development of algorithms have provided the necessary compu- 
tational programming tools for data processing and data handling 
and analysis. Algorithms that have been developed thus far, are 
adequate and have been proven successful for several preliminary 
and fundamental applications such as software interfacing capa- 
bilities, probability distributions, grey level print plotting, 
contour plotting, isometric data displays, joint probability 
distributions, boundary mapping, channel registration and ground 
scene classification. This report is written in two sections. 
Section I consists of the algorithms that have been developed 
individually under the existing contract and section II is a 
description of an Earth Resources Flight Data Processor, (ERFDP) , 
which handles and processes earth resources data under a users 
control. 

SECTION I INTRODUCTION 

In this section a description of each algorithm developed 
under the existing contract will be presented. The algorithms 
were developed as building blocks toward an automatic data pro- 
cessor for processing earth resources flight data. Each algorithm 
has been demonstrated to be compatible in an overall automatic 
processing environment. These algorithms were developed using 
an IBM 7094 computer with 32K available core storage. 
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1. PROBABILITY DISTRIBUTION 


A probability density function was programmed, and the earth 
resources data processor which is available upon request as an 
option selection is included. This option gives a probability 
density function for any number of channels, not to exceed 12, 
of the multispectral data. This option is used when calculating 
the slicing intervals of the probability distribution to provide 
grey level mapping of any ground scene image. An estimate of 
the probability density function is obtained digitally by divid- 
ing the range of the data into a desired number of class inter- 
vals d^. The probability of occurrence of a value in the 
class interval is then given by 


P^X) = N.(X)/N, 


where N^(X) is the number of values that occur within the range 


of d t < X <£_ d i+1 and 


k-1 


N N i 


i=0 


is the total size of the population where K = number of class 
intervals . 


A. Computer Program 

The computer program calculates the probability density of 
any channel of a multispectral scanner consisting of 12 channels 
of data. The distribution table is then printed out for all " 

channels requested, over all the data samples (see table I) . 

The program also passes to the grey level module the probability « 

distribution of each channel for grey level mapping. 
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NUMBER OF OCCURRENCES 



B. Data Problem Parameters 

Number of channels or spectral bands on input tape 

Number of samples per record or resolution ele- 
ments across one scan 

Number of scans to process 

Starting resolution element 

Stopping resolution element 

Bit length of input data word 

Signifying FORTRAN or non- FORTRAN input tape 

Type of input data; Floating point or fixed point 

MSFC scanner format option 

Logical unit to load input tape 

Number of initial data records to skip before 
processing 

Data incrementation 

Maximum value in data set 

Minimum value in data set 

Number of channels to calculate probability density 
function 

Channel selection for probability distribution 
calculation 

2. GREY LEVEL MAPPING 

In order to preview earth resources data and obtain quick- 
look information, a grey level mapping program was written to 
include in the ERFDP . This gives a pictorial display of the 
ground scene image quantized to 10 different levels. Characters 
are selected to represent varying shades of grey. The levels 
are calculated by slicing the probability distribution table of 
selected channels into 10 separate cells (see Figure 1) . The 
number of occurrences in each cell is equally distributed over 
the probability distribution. This is done by calculating 
equal areas for each cell using the trapezoidal rule method. 

Each of the 10 areas would represent one cell of the probability 
distribution. Each resolution element is compared with all the 
cells, and the cell in which it falls is assigned the respective 
alphanumeric character. 


NCH 

NSPS 

NSCANS 

NSTART 

NSTOP 

NBTLG 

MODE 

ITYPE 

MSFC 

LTN 

NSKIP 

NCRE 

XMAX 

XMIN 

NOCHS 

NWHICH 
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A. Computer Program 

The computer program was written as a module to be included 
in the ERFDP. The logic provides communication with the prob- 
ability distribution program, since information calculated in 
that module is used in grey level mapping. The data are input 
to the program module and each resolution element input to the 
module is compared with each cell unitl it falls within the 
quantized level of that cell. Each resolution element, x. , is 
examined such that 

SLICE (j-1) < SLICE (j) 

where j = 1,2,3 . . . , 11. 

After the data point, x^ has been quantized by this method, 
it is replaced by its representative alphanumeric character and 
plotted or printed. The plotting is output to the Stromberg- 
Carlson 4020 recorder for display. 

If automatic quantization is not desired, the program pro- 
vides an option where the user can input quantized levels as a 
table if other methods are desired (reference ERFDP users manual, 
section II of this report) . 

B. Data Problem Parameters 

Number of channels on input tape 

Number of samples per record or scan 

Number of scans to process 

Number of scans to skip before processing 

Starting sample number in the scan 

Stopping sample number in the scan 

Number of passes to make processing 120 samples 
each pass 

Number of quantized levels plus one 
Selected channel used in grey level mapping 
Option to print grey level 


NCH 

NSPS 

NSCANS 

NSKIP 

NSTART 

NSTOP 

ITERM 

N 

ICHAN 

IPRT 
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IPLT 

INCX 

INCY 

NSTX 

NSTY 

NBTLG 

MODE 

ITYPE 

MS PC 
NCRE 
LTN 
IOPT 


Option to plot grey level 

(rasters) ^ * direction for each sample 

(rasters) ^ y direction for eac ^ sample 

Starting x coordinates or plot frame 
Starting y coordinates on plot frame 
length of input data words 
Signifies FORTRAN or non-FORTRAN 
Type of input data; Floating point or fixed 


MSFC scanner format option 

Data increment 

Logical tape unit to load 

Option to select automatic 
or input quantized table 


input data 
quantization 


3. CONTOUR PLOTTING 

In the analysis and interpretation of earth resources data, 
a useful tool is means of locating and outlining borders of 
ground scene images and also plot the snow pack temperature pro- 
files recorded by an electronic scanner. A computer program was 
written to generate line plots, which is a line connecting points 
of boundaries, specified altitudes, temperatures, etc., provid- 
ing a graphical display of contour levels or borders of ground 
scene images . 

The data array to be plotted consists of the input data 
array only. These data points are ordered in an x y coordinate 
system. Four adjacent data points and their coordinates are 
examined to determine if a specified value intersects any of 
these four points. If an intersection occurs, these coordinates 
are converted to plotting raster counts, and two points are 
flagged. One point being coordinates of the entry point to the 
four adjacent data points and the other being the coordinates 
of the exit point of the four adjacent data points. If the inter- 
section of a specified level continues to the next four successive 
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adjacent data points, then the coordinates of the exit point 
become the coordinates of the entry point of the next four adja- 
cent data points. A search continues for the coordinates of 
the exit point and this procedure continues until the data set 
is exhausted. Lines are drawn connecting the points, reflecting 
continuity of the specified level. If the entry and exit point 
of successive four adjacent data points exist, then a line con- 
necting these points is continuous. Otherwise, there exists a 
discontinuity and the points will not be connected. Continuous 
lines of multiple levels can be drawn reflecting contours of 
altitude, temperatures, and homogeneous area boundaries. 

A. Computer Program 

The computer program was written as a module to be included 
in the ERFDP and was designed to contour data sets of infinite 
lengths. However, only 2500 data points reside in the computer 
at one time because of the physical storage limits. Since only 
one block of data is processed at one time, the program auto- 
matically reloads blocks of data and abuts each block to provide 
a continuous plot of contours . 

In Figure 2 contours of boundaries were plotted of the first 
120 scans of field Cl from the Purdue data set. The data were 
blocked such that contours of 1776 resolution elements were plotted 
which covered eight scans. Each resolution element covered eight 
rasters on the plot frame, therefore each block abutted together 
occupies 64 rasters. After the abutment process, the boundary 
contours appear continuous. The boundaries that were contoured 

are shown in Figure 3. The boundary contours are elongated slightly 
due to scaling on the plot frame. 
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Figure 2 Boundary Contours (Purdue Cl) 



Figure 3 Boundary Determination Channels 4 of 12 (Purdue Cl) 


B. Data Problem Parameters 


NCH 

NSPS 

IRW 

NCHAN 

NSNCRE 

NPCRE 

NPTSL 

NPTSU 

NOTLG 

ITYPE 

MSFC 

NSKIP 

MAXSCN 

NSECT 

MSZX 

MSZY 

BLK 

FHINC 

ZMIN 

ZMAX 

LAB 


Number of channels on input tape 

Number of samples in a scan 

Logical tape units to load input data 

Channel number 

Number of scans to increment 

Number of samples to increment 

Lower starting point 

Upper stopping point 

Bit length of input data word 

Type data on input tape; Floating point 
or fixed point 

MSFC scanner format option 

Number of records to skip 

Total number of scans to process 

Number of sections to process 

Data block size in x (samples) 

Data block size in y (scans) 

Plot frame block size in rasters 

Contour level increment 

Minimum contour level 

Maximum contour level 

Label interval 


4. ISOMETRIC DISPLAYS 

On occasion it has become necessary to preview the raw da ta 
and to determine the physical appearance to better understand 
the behavior of data collected from various ground scenes and 
from different types of sensors. For this purpose an isometric 
program was written to produce a two-dimensional projection of 
a three-dimensional graph of the raw data amplitude versus the 
x and y ground scene coordinates. 
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A. Computer Program 

Program Isometric will handle any FORTRAN IV formatted 
tape with up to 12 channels of data. Only one channel is plotted 
per computer pass and the channel selection is based upon an in- 
put parameter. 

The program was developed to produce two-dimensional data 
projections of ground cover scenes where data are gathered by 
sensors aboard an aircraft. The data collected across the flight 
line represent resolution elements, and the data collected along 
the flight line represent scans. Any NXM array can be displayed 
where N is the position in an array and M is the value to be dis- 
played. The program does not require large amounts of core 
storage since it performs a continuous operation on the NXM array 
which is refilled before each operation. 

The Stromberg-Car Ison 4020 frame reference coordinates are 
a ^ erec ^ a fter each operation for proper scaling based on the input 
parameters provided by the user. These parameters also control 
the density of the points plotted and the angle of rotation de- 
sired for display. Multiple plot frames are generated as neces- 
sary to display all the input data. To provide frame abutment 
for a continuous plot, the last row of each frame and the last 
sample of each row is stored and repeated on the next frame. 


NCH 

NSPS 

IRW 

NCHAN 

NSNCRE 


B. Data Problem Parameters 

Total number of channels per resolution 
element on input tape 

Total number of resolution elements per 
channel across the ground scene 

Logical tape number for input data 

Number of the channel that isometrics are 
to be displayed 

Number of scans to increment along the 
flight line; This provides an option to 
use every scan line, every other scan 
line, etc. 
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NPCRE 

NPTSL 

NPTSU 

MAXSON 

YMIN 

YMAX 

NBLSZX 

NBLSZY 

NSECT 


NSMOV 

NDIREC 


Number of resolution elements to increment 
going across the flight line; If every 
resolution element is not desired, resolu- 
tion elements can be skipped. 

Starting resolution element number for 
the isometric 

Stopping resolution element number for 
the isometric 


Total number of scans along the flight 
to display 

The minimum value of the input data used 
for calculating scale factors for plotting 
tne y axis 6 

The maximum value of the input data used 
also for calculating scale factors for 
plotting the y axis 

Stromberg-Carlson 4020 reference frame 
coordinate increment in the x direction 

Stromberg-Carlson 4020 reference frame 
coordinate increment in the y direction in 
raster counts (normal range 6 to 12) 

NBLSZX and NBLSZY are used to determine 
the degree of rotation of the isometric « 

Number of passes through the data neces- 
sary to^ display the full- scan width: 
ir NPxSL and NPTSU only cover a portion 
the data then NSECT can be adjusted 
to cover all the data. 

Example: 


If NPTSL = 1, NPTSU = 128 and NSPS - 256 
then NSECT = 2 will cover resolution 
element 1 through 128 and resolution 
element 129 through 256. 


Number of points in a moving mean span 
used in smoothing the input data; Set 
to zero if smoothing is not desired. 

Direction of the rotation of the iso- 
metric; 1 = counterclockwise and 
-1 = clockwise rotation. 
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A portion of flight line Cl (Purdue data set) was used 
in the following examples. Every resolution element and every 
scan was used requiring two passes through the data. NSECT 
was set to 2, but only one section is shown here. NBLSZX and 
NBLSZY were set to 8 and 12 respectively and both counterclock- 
wise and clockwise rotations were used. 

Figure 4 shows scan lines 86-129 and resolution elements 
1-111 of the total 222 elements of channel 8. NDIREC was set 
to -1 to rotate clockwise. Figure 5 shows channel 8 with only 
NDIREC changed to +1 to rotate counterclockwise. Figures 6 
and 7 reflect identical isometrics using channel 2 of the same 
data . 


5. DYNAMIC JOINT PROBABILITY DISTRIBUTION 

Extensive data analysis of data on hand has revealed inade- 
quacies in the current joint probability distribution program. 

The program was restrictive in that a fixed amount of square 
storage array allocation was required. This meant that, the 
greater the spread of the clusters of the joint probabilities 
or individual data pairs, the larger the square storage array 
required. This also required a screening of all the data to 
determine the ranges of data pairs. After determining the data 
ranges, the minimum square storage array required to display 
the joint probabilities became NXM, where N is the range between 
the minimum and maximum value of the X data in the joint pairs, 
and M is the range between the minimum and maximum value of the 
Y data in the joint pairs. As this clearly points out, this does 
not adapt itself favorably to data that is ill behaved and pos- 
sessing widely spread data clusters or widely spread individual 
data pairs. Due to the physical limits of the computer storage, 
in numerous cases, a considerably amount of data was lost. This 
depended largely on the characteristics of the data and since 
the primary function of the program was to display the dependent 
characteristics of two data channels, this required rerunning 
the program and making adjustments to the limits. Therefore, 
the program became inadequate. 
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FLIGHT LINE Cl 
SCANS 1-43 

RESOLUTION ELEMENTS 1-111 
ROTATEO CLOCKWISE 
CHANNEL 8 0.58-0.62 (MICRONS) 
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flight line Cl 

SCANS 1-43 

RESOLUTION ELEMENTS 1-111 
ROTATED CLOCKWISE 
CHANNEL 2 0.44-0.46 (MICRONS) 
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RESOLUTION ELEMENT 
DIRECTION 





A new technique has been employed, that adapts itself to 
data of any nature, particularly cluster data where the data 
clusters are tremendously scattered. The technique requires 
only as much storage as actually required by the number of dif- 
ferent data pairs and the size of the data storage required is 
not dependent on the ranges of the data. 


6. JOINT PROBABILITY DENSITY FUNCTION 


A joint probability density function program is a necessary 
tool in the analysis of earth resources flight data. This pro- 
gram gives a preliminary insight to the commonality of occur- 
rences observed from two time- series data traces. 

For applications to feature extraction, the outputs of this 
program give insight to the distinctness of different features 
and the location of decision boundaries necessary to separate 
different features. 

The joint probability distribution is calculated digitally 
by selecting a range [a, b] on both sets of data X, Y and divid- 
ing the range into K intervals. This gives 


C 


b-a 

K 


scale factor 


To find the X and Y coordinate for each variable X and Y jointly, 
an indexing pointer is calculated for each value of X and Y by 


( x n " a > 

I - — and I 

x c y 


<v a > 

C 


An integer one is added to the coordinate p(I x ,I ) for every value 
of X and Y in the interval [a,b] . The coordinate p(I ,1 ) con- 
tains the total number of occurrences. ^ 
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A. Computer Program 

Data points are paired (user option), given a class, and 
are stored in two single arrays, one for the X coordinates, 

NP X , and one for the Y coordinates, NP^. The number of data 
pairs that are common is accumulated in an array NKNT (i) iden- 
tifying the class and the number of occurrences, i, of that class. 

The first data pair read from the input tape, will be as- 
signed class number 1 automatically. All subsequent data pairs 
read from the input tape, will be compared with all the indivi- 
dual data pairs that have been assigned a particular class. If 
no match is found during the comparison, a new class is created, 
using this data pair. There can be up to 4000 different classes 
of paired data points stored. 

Once all the data pairs are classified, the data pairs are 
arranged and sorted such that the Y coordinates or vertical data 
are sorted in descending order and the X coordinates or horiz- 
ontal data are sorted in ascending order. Data are rearranged 
in such a way that the largest spread between the minimum and 
maximum is displayed on the vertical axis , which is printed down 
the print paper. An example of the three data arrays containing 
the joint probability before and after the vertical sort is shown 
in Figure 8a and 8b. 


B. Core Storage Image 

For any data configuration, the core storage image will 
appear as in Figure 9a. Projecting this onto an NXM storage 
array used in the conventional method, shows the wasted storage 
which is used to store blanks (or no occurrences). See Figure 9b. 
The conventional data storage method required for this example 
is 6 x 7, or 42 core storage locations. The present scheme re- 
quires only 21 core storage locations to display the above example. 
The advantage, also, is that only 21 core storage locations are 
necessary regardless of the scatter of the joint probabilities. 
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Figure 8 Data Arrays Before and After Vertical Sort 
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Figure 9 Core Storage Image 
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In Figure 10a and 10b is an example of the same number of paired 
classes, but the data pairs are more widely scattered. In this 
example, the conventional data storage required is 14 x 12 or 
168 core locations. The present scheme still required only 21 
core locations . 


C. Output Display 

To display the arrays as a joint probability distribution, 
the first location in the NP y array is examined and a decremental 
counter is set equal to this value. All the data points in the 
NP x array that are paired with this NP y value, are collected 
along with their number of occurrences NKNT(i) , and stored in a 
working array. This working array is sorted in ascending order 
for printing from left to right across the print paper. A print 
line is loaded with blank characters and the blank character is 
replaced with the number of occurrences in that location, if any 
exist. The number of occurrences is designated by an alphanumeric 
character of some hierarchy ordered by the user. The print line 
is then output to the printer. The next location in the NP 
array is examined and the counter is decreased by one. If the 
NPy value is less than the counter, a print line filled with 
blank characters is printed and tagged with the value of the 
counter. The counter is then decremented and compared with the 
NPy value again. If there is a comparison, then the above proce- 
dure is repeated. This continues until the NP y array is exhausted. 


NCH 

NSPS 

NSCANS 

NSKIP 

NSTART 


D. Data Problem Parameters 

Total number of channels on input tape 

Samples per logical record or scan line 

Number of logical records or scan lines 
to process 

Initial physical records to skip before 
processing 

Starting sample number 
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b. Conventional Core Storage Configuration 


NSTOP 

Stopping sample number 

LTN 

Logical tape unit to load input data 

NOJP 

Number of paired joint probabilities 
to process 

IMX 

X channel select 

IMY 

Y channel select 

SCALE 

Used to scale data 

BIAS 

Used to shift data 


7. BOUNDARY MAPPING 

A concerted effort has been made to improve boundary mapping 
techniques and to extend these ideas and techniques in order to 
classify different homogeneous areas of ground scene data. This 
section briefly describes one of several boundary enhancement 
techniques, which were investigated, and contains examples of 
t 0 st cases and problem parameter Inputs* 

The technique employed in this computer program, incorporates 
a moving rectangle made up of four adjacent resolution elements 
moved successively through the data. The configuration, produced 
by the magnitude of any four adjacent resolution elements con- 
nected by an imaginary path, will be defined as the area. Iso- 
metric displays of the ground scene (Figure 11) show different 
area configurations produced by any four adjacent resolution 
elements. The possible area configuration models are shown in 
Figure 12. From these configurations, the equations for calculat- 
ing the area were derived, based on two cases presented by the 
data. Case I is the area produced by four adjacent resolution 
elements along the Y and Z plane, and case II is the area pro- 
duced by four adjacent resolution elements along the X and Z 
plane. The equations that were derived (A^ Bj^, C ^ for case I 
and A£, B 2 , C 2 for case II) are shown in Figure 13a. 

Several equations that appear here are redundant and are 
eliminated by combining similar equations. The composite test 
statements that determine which equation to use, are shown in 
Figure 13b, and a flow diagram of the decision logic incorporated 
in the computer program, is shown as Figure 14. 
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Figure 11 Isometric Display of Ground See 



n 



Figure 12 Area Configurations Produced by Four Adjacent Data Samples 
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CASE I 


CASE II 


«( x „, v „)-( X n, V n + l>- (X n + l, Y n> + < X n + l, V n + l» ^ Vn HX n H Wn )+( Vl /„ + l 

Vn H Vn + l > + < X n + l , Y „H X „ + , ,Vl » «<*„.»„)-(*„, Y„ti > + < X n*l , Y n>-< X n + l ,Vl » 

«« X n. Y n> + ‘ X n. Y n + l»-‘ X n M. Y n>-‘Vl.Vl» «-‘ X n. Y n> t ' X n. Y n+l , - (X nH. V n> + ‘ X n + l. Y n.l>3 

l ‘^'* X n, Y n* + * X n, Y n+l* + * X n+l, Y n'"* X n+l Y n+l^ %[- (x V )+(X Y ,)+(X . Y )-(X , Y ; 

r/ , , % L v n, n' n, n+1 ' v n+1 , n' n+1 , n+<- 

! ‘[( x „, Y „)-( X n, Y n + l>-< X n + l, Y n> t ( X n + l, Y n t l !] 
^< X n, Y n> +( V„ + l HX n + l , Y n>- (X n + l ,Vl )] «(X n> V n )-(X n _Y n+1 )+<X n+1 / n )-CX „ +1 _Y nt) i] 


X n,V x „.Vl 

X n+l,V X n+l, Y n+l 

X n+l, Y n+l> X n, Y n+l 


COMPOSITE TEST STATEMENTS 


X n , Y n <X n , Y n+l 
X n+1 , Y n >X n+l , Y n+l 

X n,VVl. Y n 


X Y <X Y 
n, n n, n+1 

n+1 , n n+1 , n+1 

X Y >X ,, Y 
n, n n+1 , n 


X Y >X Y , 
n, n n, n+1 

X n+l, Y n <X n+l, Y n+l 

X n+1 , Y n+l <X n , Y n+l 


X Y <X Y 
n, n n, n+1 

X , , Y <X ,, Y 
n+1 , n n+1 , n+1 


X Y >X Y , 
n, n n, n+1 

X .i Y >X ,, Y xl 
n+1 , n n+1 , n+1 


Figure 13 Area Equations for Four Adjacent Data Samples 
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DECISION LOGIC 
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A probability density distribution of the area is calculated 
for each channel of data and every scan. An estimate of this 
probability density function is obtained digitally by dividing 
the range for X into an appropriate number of class intervals, 
say d^, and by tabulating the number of occurrences in each of 
these intervals. The number of occurrences N.. in each interval 
satisfies the equation 


where k = number of class 
This number sequence 
= Total 

N 2 = Total 
= Total 

• 

N k = Total 

A plot of the probability distribution of channel 3 and 
channel 12, both horizontal and vertical, are shown in Figures 15 
and 16. These plots reflect the distribution of one scan of data 
in particular, scan number 5. The criterion to determine if a 
resolution element reflects a change in a homogeneous population 
of ground scene is the mean of the probability distribution of 
the area plus its associated 0. All area calculations of four 
adjacent resolution elements that fall outside of the mean plus 
6 will be flagged as a boundary. 


k-1 

N H t 

i=0 


intervals and N is the total population 
{ N i> is found by 

X/ d. 


number of X 
number of X 
number of X 


d L < X C d 2 

d 2 < XC d 3 


number of X: X <£_ d^ 
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Figure 15 Boundary Determination, Probability Distribution Channel 




Figure 16 Boundary Determination, Probability Distribution Channel 12 





The mean area of the probability distribution, P(A) , is 
calculated by 


TOT 



i“l,2, . . .MAX 


on 6 by 


2 p < A i) k \ 

_i 

2 P(A i ) 



i-1,2. . .MAX 


In the test cases, all 12 channels were used, except for 
two cases where channel 3 and channel 12 were run separately, 
and boundary flags set for each channel. The final decision 
for determining the boundary, is based on an input parameter 
selected by the user. The number of channels indicating a 
boundary has to be greater than this value. In Figure 17 only 
channel 12 was used. This produced too many boundaries and 
the separation of different homogeneous areas was not clearly 
defined. In Figure 18 only channel 3 was used; this produced 
too few boundaries. Figure 19 shows all 12 channels with at 
least seven reflecting boundaries (Input Option); this produced 
too few boundaries. Figure 20 shows at least three channels of 
the 12 reflecting boundaries which produced too many boundaries. 
Figure 21 produces the best boundary map which uses at least 
four channels of the 12 total. 
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SCAN 1-120 RESOLUTION ELEMENT 1-222 



l/)U<Z 
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Figure 18 Boundary Determination Channel 3 (Purdue Cl) 



SCAN 1-120 RESOLUTION ELEMENT 1-222 



WU< 2 
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Figure 19 Boundary Determination Channels 7 of 12 (Purdue Cl) 


SCAN 1-120 RESOLUTION ELEMENT 1-222 



wu<z 


37 


SCAN 1-120 RESOLUTION ELEMENT 1-222 





(/)U<Z 
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Figure 21 Boundary Determination Channels 4 of 12 (Purdue Cl) 


N SCANS 

NSTART 

NSPS 

NCH 

NVAR 


NSYM 


ISUM 

NTEST 

NBTLG 

MODE 

NSKIP 

NCRE 

NBLK 

INCX 

INCY 

NSTX 

NSTY 

NWHICH 


A. Data Problem Parameters 

Number of scans or logical records to process 
an input tape 

Starting resolution element in the scan 

The number of resolution elements or columns 
to process from each scan 255) 

Number of channels present on input tape 

Number of variables or intervals desired in 
calculating the probability distribution; 
Maximum of 2000. 

Number of alphanumeric characters to display 
boundaries (note: At the present only two 

characters are used, blanks and dots , no 
boundary or yes boundary respectively) . 

Total number of channels used in initial 
boundary calculation 

Number of channels (plus one) , of ISUM, 
necessary for a final boundary decision 

Number of bits per word on the input tape 

Mode of input tape ( 2 =non- FORTRAN, 1=F0RTRAN) 

Number of records to skip before processing 
input data 

Data increment 

Number of raster counts per character desired 
in displaying boundary on the Stromberg- 
Carlson 4020 plotter recorder 

Raster counts incrementation in the X direction 

Same as above in the Y direction 

Starting position or frame along the X axis 

Starting position on frame along the Y axis 

Channel number desired in calculation of 
boundary 
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8. CHANNEL ALIGNMENT 


In recent month® there hes been an increasing demand to 
process and analyze data collected by array cameras using dif- 

d^Tf ^ ^ £requency s P ectr um. In order to analyze 

rte dfe^i f S C “ era SOUrCe> ^ Can,era fita 18 ^Sitized and 

tered f^ r Pr<>Ce88 ^ “ tttad ° Ut Sep8ratel y each fil- 
tered film. Gross errors are introduced into the data, mainly 

- salrgnment of the film when being digitized by a densitometer. 

This misalignment must be compensated for before the digitized 

a can be merged and processed. A process was developed to 

a ign t e digitized data sets by a matching matrix technique. 

Boundaries separating homogeneous areas are calculated from 

“h S6C < 8 « —ion 7) and the boundaries of each data 

set are correlated and matched. One particular technique pro- 

seTis iV he TV* NX " '" atrlX f ° r e8Ch d8ta 8 « “here one 
is assigned the reference channel and the other sets are 

correlated with the reference channel by moving the matching 

matrix successively through the selected data area. 

is dor b : 0rr : l h ?° n ° f the reference clulnnel " ich other channels 
refe ^ ! Chl " 8 0r correlatln S a resolution element from the 
rence channel with all resolution elements in the matching 

" boll “• “ Chere ^ • — h or correlation 

rieS ’ t 6n 3 Cel1 ln the maCc hing matrix display at those 
coord s incremented. The NXM matching matrix is Led by 

one resolution element, and the next resolution element from the 

LL"! e . C lr 18 ” ,atChed ° r C0rr6laCed ihe resolution 

lements in the matching matrix of other channels. If ther e exists 

a match or correlation of boundaries, then a cell in rh „ ! 

matrix display at those coordinates is again incremented.”!!! 8 

the ::zz £at:La 8 r rlx 18 °° ved successiveiy ^ 
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An expanding and collapsing technique is employed at the 
beginning and end of the data set to eliminate edge effects and 
loss of data. As the NXM matching matrix is moved successively 
through the data set, the correlation of the two channels, if a 
correlation exists, is accumulated at the beginning of the data 
set at the matching matrix display coordinates MATRIX (i,j) 
going across, where 

i = | - b+ 1 , § - b+ 2 , . . . N ; k = 1 , 2 , 3 . ..Ij , 

and going down where 

j = 3 ? - b+ 1 , | - b+2,...M; k = 1,2.3...| . 

This continues until the entire matching matrix is within the 
objective data, thus eliminating the edge effect. Once the match- 
ing matrix is within the objective data then i = 1,2,3...N; and 
j = 1,2,3...M. Upon termination of the matching matrix at the 
end of a data set, a collapsing technique is employed. This tech- 
nique is the same as the expanding technique except the accumula- 
tion at the end of the data set at the matching matrix display 
coordinates MATRIX (j,i) is i = 1,2.3... N-k, where k = 1,2,3... 
and j = 1,2,3... M-k, where k = 1,2.3... ^ . 

The matching matrix is then printed for each combination of 
correlations. No boundary and boundary correlation of two data 
channels ( 0 . 1 ), and boundary and boundary correlation of two data 
channels (1,1). Alignment shifts can be performed by locating 
the peaks in the NXM matrix where boundaries of two channels are 
matched. The matching matrix is shown in the output example. 

This peak occurred at coordinates (-5, +4), therefore, the channel 
being correlated with the reference should be shifted -5 data 
records and +4 resolution elements to align the two channels. 
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This technique corrects for any horizontal and vertical 
alignment satisfactorily, however it does not correct for any 
skewness introduced, while the film is being digitized, or any 
distortion in the camera array angles. A technique that fully 
corrects for this type of missalignment is presently being 
developed, but due to inadequate computer turnaround time, re- 
sults are not available. 

A. Computer Program 

A program was written to match and correlate up to three 
data channels and as many different intervals of a data set as 
desired. This will enable the user to calculate the alignment 
in areas of the data set where boundaries are clear and can be 
detected. Input to the program is three FORTRAN formatted fixed 
point binary tapes containing boundary flags (fixed point integer 1 
for boundary and 0 for areas that are homogeneous) . 

B. Data Problem Parameters 

NTIMES Number of sections to correlate 

LT9 Logical unit to load input tape number one 

LT10 Logical unit to load input tape number two 

LT11 Logical unit to load input tape number three 

NSTART Starting resolution element 

NSTOP Final resolution element 

NSCANS Number of scans in the matching matrix 

NSPS Number of resolution elements across the scan 

in the matching matrix 

NREFX Starting resolution element in the reference 

channel; Tape number one. 

NREFY Starting scan number in the reference channel; 

Tape number one. 

NCH1X Starting resolution element in the channel to 
be correlated; Tape number two. 

NCH1Y Starting scan in the channel to be correlated; 

Tape number two . 

NCH2X Starting resolution element in the channel to 
be correlated; Tape number three. 

NCH2Y Starting scan in the channel to be correlated; 

Tape number three. 


42 















Channel Alignment (Concluded) 
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9. CHANNEL REGISTRATION 


Registration of digital images of the digitized film pro- 
cessed from a multiple camera array system, has become necessary 
due to the rotational, translation and scaling errors introduced 
during processing. A course alignment is made by employing the 
matching matrix technique but this only corrects for a horizontal 
or vertical shift in the digital images for alignment. There 
exist errors in the digital images, such as rotation and transla- 
tion errors, which have to be corrected by a more effective means. 

A technique which will accomplish this is presently being developed 
and has been demonstrated. Computer results are not available, 
due to contract expiration which prevented finalizing the analysis, 
therefore, no illustrations are shown. 

The technique requires generating boundary maps of the digital 
images and a manual technique is used to correlate similar areas 
of the digital images with each other. A good sampling of the 
entire scene is made which provides enough input to a set of equa- 
tions (equations are presently being derived and improved upon) 
to calculate coefficients for each digital image combination. 

When used with the x and y coordinates of a reference channel, 
position pointers are calculated giving the respective x and y 
coordinates of the channels to be aligned. Data points are taken 
from these coordinates and placed at the coordinates of the ref- 
erence channel. All channels are then output to magnetic tape 
becoming merged for further processing. 

A program was written to overlay any combination of digital 
images containing boundary information (0 and 1) that have been 
registered and merged. This overlay program produces a map showing 
the location of boundaries and homogeneous areas that are similar. 
This program is used in conjunction with the registration process 
and evaluating the accuracy of the registration process. 

After the digital images are aligned satisfactorily the reg- 
istration process can be carried out on the raw data and processed 
as desired, or the merged boundary tapes can be processed. 
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A. Computer Program 

A computer program was written to register multiple digital 
images using boundary information or raw data. The program inputs 
a reference channel and the x and y coordinates of data points 
from the reference channel are input to a subroutine FETCH which 
returns through the call statement the x and y coordinates of the 
channel to be aligned. Subroutine FETCH contains DATA statements 
with coefficients used in the calculations. These DATA statements 
can be changed to reflect coefficients of different digital images. 

B. Data Problem Parameters 

NSPS Number of samples per scan 

NCHAN Number of channels on input tape 

NSCANS Number of scans to process 
NSKIPl Initial position of tape number one 
NSKIP2 Same as above for tape number two 

NSKIP3 Same as above for tape number three 
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C. Program Flow Chart 



Channel Registration 
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10. SPECTRAL DISCRIMINATION 


Capabilities have been developed to discriminate ground 
scene features using computer techniques with digitized images. 
These capabilities are available at MSFC for analysis and inter- 
pretation of earth resources flight data. Computer programs and 
algorithms were developed during this contract period, March 22, 
1971 to September 22, 1972, under the auspices of the National 
Aeronautics and Space Administration, with Mr. Robert Jayroe 
COR. The mathematical rationale used in the development of these 
computer programs are to be published by Mr. Robert Jayroe in 
a NASA report entitled "Unsupervised Spatial Clustering with 
Spectral Discrimination." 
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ERFDP USERS MANUAL 
SECTION II INTRODUCTION 


Processing earth resources data is the future will require 
a somewhat automatic approach due to the volume of data and the 
extent of analysis required to interpret the data. This requires 
a complex data processor designed to maintain an automatic data 
processing (ADP) environment for the user. The processor is 
designed using independent modules with an executive program 
driving each module. A block diagram depicting this modular 
structure is shown as Figure 22. 

This processor uses an overlay technique, which compiles 
and communicates with all modules, but only executes modules 
selected by the user. The concept of using overlays provides 
capabilities for processing input data, through all the program 
modules sequentially or only selected modules as desired. Each 
module can be improved upon, expanded and modified independently 
of other modules, and each module can be improved or modified 

in a 32 k core storage environment irrelevant to the other modules 
(see Figure 23) . 

This conept has the disadvantage of having to utilize an 
intermediate storage tape, which necessitates executing read/write 
commands, which are certainly time-consuming. However, the ad- 
vantages outweigh the disadvantages significantly by providing 
versatility in the overall function. To further improve on the 
efficiency of the program, the read/write commands use alternate 
input /output channels when possible to eliminate, in most cases 

the computer being in a "wait" condition due to either channel ''A" 
or channel "B" being busy. 

The overlay concept entails having a main program which calls 
each individual module as requested by the user. This keeps the 
overall processing contained in one large program and each program 
module is brought into the computer, compiled, overlay structures 
created, and then output onto an overlay tape. All modules are 
treated in this fashion regardless of which and how many are to 
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ERFDP 


module 1 
, probability 
distribution 


module 3 
contours 


module 2 
grey * 
levels 


module 5 
joint 
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distribution 


module 7 
classificatioi 


module 4 
isometric 
plot 


module 6 
boundary 




cluster 


B6 A7 A3 


merge 


classify 


A6 A7 B5 B7 


Earth Resources Flight Data Processor 


Tape Assignments: 

LT1 = A3 
LT9 = B5 
LT10 = A6 
LT11 = B6 
LT12 = A 7 
LT13 = B7 
OPT = (Optional) 


Figure 23 Block Diagram ERFDP 












be used. Each module to be executed is brought into the computer 
in a "transit" area (see Figure 24), and upon completion, another 
module, if requested, is brought into the same "transit" area to 
be executed. A common area in the computer is used to store in- 
formation that may be used by more than one module. Each module 
has access to this common area at any time it occupies the 
"transit" area. 

1. EARTH RESOURCES FLIGHT DATA PROCESSOR 

The ERFDP is comprised of seven separate and independent 
modules which reside in computer memory only while being executed. 
Module seven consists of three lower level modules that are called 
into memory to perform their function automatically when module 
seven is requested by the user. The segmented structure appears 
as diagrammed. 



Each module can be called into core memory and executed 
independently and in any order with the exception of module seven. 
Module six has to be executed prior to module seven, since the 
boundary mapping output is input to module seven. If module six 
has been run previously and a boundary mapping output tape is 
available, then module seven can be executed alone. 
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TAPE 


PRINT 


CARDS 


GRAPH 


Figure 24 Block Diagram ERFDP 
Earth Resources Flight Data Processing 


57 










A dimensional variable called MODULE is dimensioned 8, 
which sets aside eight memory locations to store a users request 
for module execution. The number of locations filled depends 
upon the number of modules requested to be executed by the user. 
The remaining locations contain zeroes and when the processor 
encounters a zero while examining the list, it terminates under 
system control . 


A. Data Problem Parameters Example Setup 


$DATA 

$INIT 

MODULE = 1,2, 4, 6, 7 
$END 


User request modules 1,2, 4, 6, 7 
to be executed and in that order. 


B. Input Tapes 

“ Users option under individual modules (A6 recommended) 
Type - Reference individual modules 

C. Output Tapes 
Reference individual modules 
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2. MODULE ONE 


Module one when called into memory calculates a probability 
density function for any number of channels not to exceed 12. 

The module provides options to calculate probability density 
functions on selected channels also. 


A. 

$ INPUT 1 
NCH = 3 
NSPS = 794 
NSCANS « 500 
NSTART * 1 
NSTOP * 794 
NBTLG - 12 
MODE * 2 
I TYPE » 0 

MSFC * 0 

LTN = 10 
NSKIP - 2 
NCRE = 1 
XMAX = 1200.0 
XMIN « 300.0 
NOCHS - 3 

NWHICH * 1,2,3 

$END 

7/8 


Data Problem Parameters Example Setup 


Number of input channels 


Number of samples per record 


Number of scans or records to process 

Starting sample number 

Stopping sample number 

Bit length of input data word 

Signifying non-FORTRAN input tape 

Fixed point input; ITYPE - 1 ; Floating 
point 36-bit word input 


Not MSFC scanner format; MSFC » 1* MSFC 
scanner format ’ 

Logical tape unit of input tape 

Skip first two data records 

Data increment to process 

Maximum value in data set 

Minimum value in data set 

Number of channels to calculate probability 
density function y 


Calculate probability density function on 
channels 1,2, and 3 


d. input Tapes 


Unit 

Type 


- Users option under input parameters 

" £??H° dd 5 a ? ity binary 3- bit modulus, fixed point 
with word lengths <_ $6 bits, or floating point? 


C. Output Tapes 
None (only print output) 
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D. Program Flow Chart 



60 








Multiple Channel Probability 
Distribution (concluded) 
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OUTPUT EXAMPLE 

PROBABILITY DISTRIBUTION 
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NUMBER OF OCCURRENCES 



3. MODULE TWO 


Module two outputs on print paper and/or Stromberg-Carlson 
4020 recorder, the quantized levels of a data set with alpha- 
numeric characters displaying specific quantized levels. Alpha- 
numeric characters can be selected and input to the module on a 
card included in the input problem parameters to provide different 
shading for certain levels. This module displays only one channel 

per computer pass, and that one channel is optional and selected 
by the user. 


$ INPUT 2 
NCH = 3 
NSPS =794 
NSCANS = 500 
NSKIP = 2 
NSTART » 1 
NSTOP = 120 
I TERM = 6 

N = 11 
ICHAN - 3 
IPRT = 1 
IPLT = 1 
INCX = 0 

INCY = 8 

NSTX = 0 
NSTY = 0 
NBTLG = 12 
MODE = 2 
I TYPE = 0 

MSFC = 0 


Data Problem Parameters Example Setup 

Number of channels on input tape 

Number of samples per record or scan 

Number of scans to process 

Number of scans to skip before processing 

Starting sample number 

Stopping sample number 

Number of passes processing 120 samples 
each pass 

Number of levels plus 1 
Channel used in mapping 
Option to print 
Option to plot 

Increment in x direction for each sample 
(rasters) r 

Increment in y direction for each sample 
(rasters) r 

Starting x coordinates on plot fr am e 

Starting y coordinates on plot frame 

Bit length of input data words 

Signifies non-FORTRAN 

Fixed point input data; I TYPE = 1 ; Input 
data floating point 36**bit words 

Not MSFC scanner format; MSFC = 1; MSFC 
scanner format ’ 
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NCRE = 1 
LTN = 10 
IOPT = 0 


Data increment 

Logical tape unit of input tape 
Signifies automatic quantization 


$END 

$GRYLYL 

GLVL = 1., 2., 3., 4., 5., 6., 7. 



O 

O 



10 ., 11 . 

10 ., 11 . 


1., 2., 3., 4., 5., 6. , 7., 8., 9., 10., 11. 

$END 

7/8 

B. Input Tapes 

Unit - Users option under input parameters 

Type - Any odd parity binary, 3- bit modulus, fixed point, 
with word length <£_ 36 bits or floating point. 

C. Output Tapes 
None (only print output) 


D. Program Flow Chart 
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Grey Level Mapping 
(concluded) 
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4. MODULE THREE 


Module three calculates contour lines throughout an input 
data set depicting elevation, altitude, temperature or boundary 
contours. The contour lines are output and displayed by the 
Stromberg-Car Ison 4020 plotter. Frame butting in the module pro 
vides for continuous contour plotting for infinite data sets. 

The contour lines can be scaled by utilizing the block size 
option (BLK) in the input problem parameters. 


A. Data Problem Parameters 


$INPUT3 
NCH = 1 

Number of channels 

NSPS = 90 

Number of samples in a scan (record) 

IRW = 11 

Logical tape unit for input data 

NCHAN = 1 

Channel number 

NSNCRE = 1 

Number of scans to increment 

NPCRE = 1 

Number of samples to increment 

NPTSL - 1 

Lower starting point 

NPTSU = 90 

Upper stopping point 

NBTLG =36 

Bit length of input data word 

MODE = 1 

FORTRAN formated (1) or non- FORTRAN (2) 

I TYPE = 0 

Fixed point input I TYPE = 1, 

MSFC = 0 

floating point input 

MSFC = 1; MSFC scanner format 

NSKIP = 0 

Number of records to skip 

MAXSCN = 100 

Total number of scans to process 

MSZX = 90 

Data block size in x (samples) 

MSZY = 8 

Data block size in y (scans) 

BLK =8.0 

Plot frame block size in rasters 

FHINC =10.0 

Labeling increment 

ZMIN =8.0 

Minimum label 

ZMAX = 138.0 

Maximum label 

LAB = 1 

Label every interval 

$END 

7/8 
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B. Input Tapes 
Units - Optional under input data 

Type - Any odd parity binary 3-bit modulus, fixed point 
with word lengths <£_ 36 bits, or floating point. 

C. Output Tapes 

SC 4020 Stromberg-Carlson formatted tape 
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D. Program Flow Chart 



Contour Level Plotting 


2 









Contour Level Plotting 


73 









Contour Level Plotting 
74 
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OUTPUT EXAMPLE 

SCAN 1-120 RESOLUTION ELEMENT 1-222 
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w 0<Z 



5. MODULE FOUR 


Module four displays a two-dimensional plot of three- 
dimensional data where only one single array of data is input 
and the data samples are ordered in an XY coordinate system, 
where Y is the scan line count and X is the resolution element 
in the scan. Data sets of infinite length can be displayed on 
the SC4020 recorder. The module provides for multiple passes 

through the data set in order to view the entire data set in 
sections . 


$INPUT4 
NCH = 12 
NSPS -222 
NSKIP = 0 
NBTLG - 12 
MODE - 1 

IRW - 10 
NCHAN - 6 
NSNCRE - 1 
NPCRE - 1 
ITYPE = 1 

MSFC - 0 

NPTSL - 1 
NPTSU - HI 
MAXSCN - 120 
XMIN - 0.0 
XMAX - 222.0 
YMIN - 0.0 
YMAX - 255.0 
NBLSZX 


Data Problem Parameters Example Input 


Number of channels on input data tape 

Number of resolution elements per scan 

Initial records to skip 

Bit length of the input data word 

FORTRAN formatted (1) or non-FORTRAN 
formatted 

Logical tape unit to load input 

Channel selected to be plotted 

Scan incrementation 

Resolution element incrementation 

Fixed point input (0) or Floating point 
input (1) 

MSFC scanner format (1) or not MSFC 
scanner format 

Lower resolution element to start 

Upper resolution element to stop 

Scan lines to be processed 

Minimum value for scaling the X axis 

Maximum value for scaling the X axis 

Minimum value for scaling the Y axis 

Maximum value for scaling the Y axis 

The distance separating the plotted points 
in the X direction 
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$END 

7/8 


The distance separating the plotted points 
in the Y direction 

Two passes through the data to plot the 
data set in two sections 

No smoothing on input data 

Orientation of the isometric left view (-1) 
or right view (1) 


B. Input Tapes 

Unit - Users option under input parameters 

Type - Any odd parity binary 3-bit modulus, fixed point 
with word lengths 36 bits, or floating point 
binary. 

C. Output Tapes 

Unit - A8 SC4020 
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D. Program Flow Chart 



Isometric Program Display 
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Isometric Program Display 
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Isometric Program Display 
(concluded) 
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RESOLUTION ELEMENT 
DIRECTION 
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6. MODULE FIVE 


Module five calculates a joint probability density function 
from two time-series data traces selected by the user in the 
data problem parameters. The program provides for multiple passes 
through the data set for multiple joint probability density func- 
tions. The raised data points are classified and stored in one 
single array along with its associated occurrences of like data 
pairs. The joint pairs are sorted vertically in descending order 
and horizontally for each print line in ascending order. 


A. Data Problem Parameters Example Setup 


$INPUT5 
NCH = 12 
NSPS =222 
NSCANS = 920 

NSKIP = 0 

NSTART = 2 
NSTOP =222 
LTN = 10 
NOJP - 2 

IMX = 4,3 
IMY = 6,7 
SCALE = 1.0 
BIAS = 0 
$END 

® ( & ),/* ABC... 
7/8 


Total number of channels on input tape 

Samples per logical record or scan line 

Number of logical records or scan lines 
to process 

Initial physical records to skip before 
processing 

Starting sample number 

Stopping sample number 

Logical FORTRAN IV tape unit 

Number of paired joint probabilities to 
process 

Use channel 4 and 3 in X 
Use channel 6 and 7 in Y 
Used to scale 1 
Used to shift data 

(Alphanumeric characters) 
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B. Input Tapes 
Unit - A6 (optional) 

Type - Any odd parity binary. 3-bit modulus, fixed point 
with word lengths <£_ 36 bits, or floating point 
binary. ~" 


C. Output Tapes 
(none print output only) 
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D. Program Flow Chart 
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Dynamic Joint Probability 
Distribution 
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sample pair* 
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print 

paper 


output 

sorted 
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storage 

tape 


Dynamic Joint Probability 
Distribution 




Dynamic Joint Probability 
Distribution (concluded) 




OUTPUT EXAMPLE 

joint psoiiAHiurr oiSTtueuuoN 
XIS IS Y-AXIS IS 

OAtA SWITCH HAS CCCUKKSO 
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7. MODULE SIX 


Module six calculates boundaries outlining edges of homo- 
geneous areas of ground scene data. These boundaries are dis- 
played on print paper where a selected alphanumeric character 
signifies a boundary and blanks signify areas of homogeneity. 
This output is also displayed on the SC4020 plotter where bounda 
ries are flagged by an alphanumeric "period." The boundary out- 
put is used in further processing to extract information for 
feature discrimination. 


A. 

$ INPUT 6 
NSCANS = 120 
NSTART = 1 
NSPS = 222 
NCH = 12 
NSYM = 49 
I SUM = 5 

NBTLG = 12 
MODE = 1 

I TYPE = 0 


MSFC = 0 


NSKIP = 0 
INCX * 0 

INCY = 4 

NSTX - 0 
NSTY = 0 
NCRE = 2 


Data Problem Parameters Example Setup 


Process 120 scans of the data set 

Starting sample number 

Number of samples to process; ( <£_ 255) 

Number of channels on input tape 

Dimension of the Alphanumeric array 

Number of channels used in calculating 
boundaries 

Bit length of input data word 

FORTRAN formatted (1), non- FORTRAN 
formatted = 2 

Input data fixed point. Floating point 
binary = 1 

Not MSFC scanner format MSFC scanner 
format = 1 

Skip no records before processing 

Incrementation in the X direction on the 
plot frame between resolution elements 
for each scan 

Incrementation in the Y direction on the 

? lot frame between resolution elements 
or each scan 

Starting X coordinates on the plot frame 

Starting Y coordinates on the plot frame 

Data incrementation; Use every other data 
sample for boundary calculations 
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D 

$NCHUSE 

NWHICH = 1,3,4,8,12 Channel selection for calculating 

boundaries 

$END 

® ® @ *(- =, $+ABC . ...Z12 ...90- 

7/8 

B. Input Tapes 

Unit - Any odd parity binary, 3-bit modulus, fixed point 
with word lengths <£_ 36 bits, or floating point 
binary. 

C. Output Tapes 

Unit - B6 

Type - Fixed point binary l's and 0's FORTRAN formatted 

255 words or less plus 1 FORTRAN index per logical 
record. 
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INPUT 
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SET UP 

DISPLAY 

SYMBOLS 


OUTPUT 
BOUNDARY 
FLAGS 


INITIALIZE 

ARRAYS 

X =Y n= 
n n, 

— U NSPS 



OUTPUT 
BOUNDARY 
TO 

PAPER 



NO 




END 


Boundary Mapping (concluded) 









SCAN 1-120 RESOLUTION ELEMENT 1-222 



t/) o < z 


I 


101 


Boundary Determination Channels 4 of 12 (Purdue Cl) 


8. MODULE SEVEN 


Module seven consists of three submodules celled into core 
memory sequentially to classify land use data. These modules 
perform spatial clustering, sequential merging, and spectral dis- 
crimination of ground scene images. The module provides an op- 
tion to select multiple passes to further classify small insigni- 
ficant homogeneous areas that may be overlooked or misc lassif ied 
during the first pass. 

The input to module seven is the boundary mapped information 
(see Boundary Mapping) and the raw spectral digitized images. 

The spatial clustering submodule searches areas on the boundary 
map tape that contain homogeneous areas consisting of at least 
100 square resolution elements as a threshold. When this search 
is satisfied, this homogeneous area is identified with a number 
which is incremented for each separate homogeneous area. A new 
tape is created containing these identified clusters. The sequen- 
tial merging submodule searches the tape containing the identified 
clusters and selects the raw spectral data associated with each 
cluster. Criterion parameters are calculated and the merging 
process takes place merging all similar clusters. 

The spectral discrimination submodule, classifies the merged 
clusters starting with an initial class of one, with unit incre- 
mentation for each new class detected. The raw spectral data 
criterion parameters, for each resolution element are compared 
with all classification criterion parameters. If a comparison 
exists, then the resolution element becomes classified. If there 
is no comparison, the resolution element is assigned a blank or 
a boundary flag, (if the resolution element reflects a boundary) . 

If the ground scene is not classified satisfactorily, another 
pass can be performed reducing the homogeneous square area thres- 
hold to 36 resolution elements. This will enable smaller homo- 
geneous areas, that were not detected by the 100-square resolution 
element threshold to be detected and an attempt will be made to 
classify these areas also. 
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In the output example of module seven. Figure 25 shows the 
initial clustering of homogeneous areas that contain at least 
100 square resolution elements. Figure 26 shows the results of 
the sequential merging and the classifying process. In Figure 26 
there exist areas that were not classified therefore an additional 
pass was necessary to improve the classified areas. Figure 27 
shows small homogeneous areas clustered using the 36-square reso- 
lution element threshold. These areas are clusters 0, P, and Q. 
Figure 28 shows the areas 0, P, and Q, have been merged and classi- 
fied which improves the classified images. 


A. Data Problem Parameters Input Example 


$INPUT7 
NPASS = 2 

NCLUST = 0 

$END 
$INPUTA 
NSPS « 222 

NSCANS = 120 
NCH = 12 
LT1 = 1 
LT9 = 9 

LT10 = 10 
LT11 = 11 
LT12 = 12 

LT13 = 13 

NSTART - 1 
NSTOP = 140 


Perform two passes through the clustering, 
merging and classifying process 

Initial cluster number. Additional passes 
can be performed on reruns , by inputing 
the total number of classes already detected. 


Number of resolution elements in entire 
scan or logical record 

Number of scans to process 

Total number of channels on input tape 

Logical tape unit for scratch tape 

Logical tape unit for storage of update 
information 

Logical tape unit for raw data input 

Logical tape unit for boundary map 

Logical tape unit for clustered homo- 
geneous areas 

Logical tape unit containing the final 
classified map 

Starting sample number 

Stopping sample number; Process only 
sample number 1-140 (NSTOP- NSTART + 1 <_ 255) 


NBTLG = 12 Bit length of word on input raw data tape 

MODE * 1 Input data FORTRAN formatted 

MODE - 2 non-FORTRAN formatted 


103 


SPATIAL CLUSTERING 

PASS 1 SCAN 1-120 RESOLUTION ELEMENT 1-140 


Sill 
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till 
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till 
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min 
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mm 
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Figure 28 Merged and Classified Homogeneous Areas 
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I TYPE = 0 
MSFC = 0 


14 = 1 


Input tape binary integer ITYPE - 1, 
floating point format 

Non-MSFC scanner format; MSFC scanner 
has housekeeping data requiring special 
handling. 

Set MSFC = 1 if MSFC scanner data 

Number of physical records per logical 
record 


NCRE = 1 

NSKIP = 0 
INCX = 0 

INCY = 8 

NSTX - 0 


Data increment; NCRE = 1 use every data 
sample 

Initial records to skip before processing 

Increment in X direction on SC4020 plot 
frame for each sample 

Increment in Y direction on SC4020 plot 
frame for each sample 

Starting X coordinate on the SC4020 plot 
frame 


NSTY = 0 


Starting Y coordinate on the SC4020 plot 
frame 


IXXX - 10 Homogeneous area threshold samples in X 

IYYY = 10 Homogeneous area threshold samples in Y 

direction 

<a Q . 1234567890ABC ....(Alphanumeric characters for displaying 
classified homogeneous areas) 


B. Input Tapes 


Unit - A6 and B6 

A6 is any odd parity binary, 3- bit modulus, fixed 
point with word lengths <£_ 36 bits, or floating 
point binary. 

B6 is integer binary FORTRAN formatted. 


C. Output Tapes 

Units - B5 FORTRAN floating point binary 
(update information) 

A7 FORTRAN fixed point binary (Cluster data) 
B7 FORTRAN fixed point binary 


D. Intermediate Tapes 
Units - A3, Scratch tape only 
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E. Program Flow Chart 
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Spectral Discrimination 
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Figure 29 IBM 7094 Job Deck Setup 
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7094- INSTRUCTIONS 


NAME: 

5pA n Do 

op code: // 

STACK ^ 


L0C 

job Z 34 


IF EXCEEDS MAX: 

□ STR OSTE ODMPORETSY 

FAST TAPES . A B C D 

INPUT TAPES 

WORK 

LOGIC 


LOGIC 

REEL NO 

DEN 

CfrtBSYS 
□ Ipook 
DITHER 

rfr€pMPL /ASSMBL 
GtXECUTE 
□ £UNCH(BC0 BIN) 

m 

5&5&S' 

3 

Sc 




fry 

(fr^FTRN 

□ 2 FTRN 

□ apt 

□ PERT 

□ MAP 
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S3 

LINES OF OUTPUT (1000'S) 

□ Q-3 Jrf-is QI3-30 DOVER 

MAXIMUM TIME 
HOURS MINUTES 

PROGRAMMER COMMENTS: 

NUMBER OF CASES 


Con, e n + ) Co n- ns e r, -j- 


OVER: 



□ SEE ON-LINE 


□ SEE TECHNIQUES 


□ MAX EXCEEDED 

OPERATOR COMMENTS: 

□ RETURN TO SYS 


□ LINE MAX 


OPER INIT:- 

over:- 


OUTPUT TAPES ONLY 


REEL NO 

1 LOGIC 


UNIT 

NO OF CPYS 

SAVE 

TAPE 


B-l 

8 






warn 
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im 
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4020 


NO FILES 
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MSFC - Form 533 (Rev February 1966) 


Figure 30 IBM 7094 Instruction Form 533 
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Computer Program Listing 
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##**##***#*#* j p m yOou PROGRAM LISTING WITH JOB CARDS************* 


SJOB NASA JAYROE BIN 53 ,434300 » 00 * 1 2 ♦ 1 4MCE 

SEXPCUTF I B JOB 

tIBJOB FI0CS,MAP 

SFILP -UNIT03-,N0NF 

SFILc -UN I T 04- » NONp 

SFILF -UN I TO?- ♦ NONF 

$FILP -UNI T08- ♦ NONF 

SFILP -UNI T 1 4- ♦ NONE 

$PIir -UN I T 1 5- ♦ NONE 

SlRFTf FRFDP 

DIMENSION MODULF(R) 
rOMMON DATA ( *1 2 ) 

namfltst/init/modulf 

DO I 1 = 1,8 

I MODULE (I)=0 
1 = 0 

Read < 5 ♦ t n I t i 
WRITE(6*INIT) 

998 CONTINUE 
T = T + 1 

TGO=MOOULF( I ) 

IF ( I GO .LF. 0) GO TO 099 
GO TO < 10. 11 *12*13 ♦14,15*16 1 »IGO 
10 CONTINUE 
CALL PROB 
GO TO 998 

II CONTINUE 
CALL GLFVFL 
GO TO 9pp 

1? CONTINUE 

CALL JONTPB 
GO TO 998 

13 CONTINUE 
CALL ISOMET 
GO TO 998 

14 CONTINUE 
CALL CNTLTN 
GO TO 998 

15 CONT1NUF 
CALL BWNDR3 
GO TO 998 

16 CONTINUE 
CALL CLASFY 
GO TO 99p 

999 CONTINUE 
CALL CLEAN 
STOP 

END 


$OR I G I N ALPHA ♦ SYSUT2 *REW 
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/ 


*IBETC MODI 

SUBROUTINE PROR 
COMMON DATACi?) 

COMMON/C 1 f GLVL (11*12) ♦ NWH I CH( 1? ) 

DIMENSION NT ABLE ( 201*1?) * DAT ABC 201) 

namelist/inputi/nch,nsps,nscans,nstaRt,n S top,nbtlg,mooe, 

IITYPE. MSEC. LTN, NSMP* 

1 NCR E . XMAX ♦ XM I N , NOCHS * NWH I CH 
READC 5* TNPUTl ) 

WRITP(6»TNPUTI ) 

C CALCULATE PROBILITY DISTRIBUTION TABLE 

Resol* cxmax-xmiN)/?oo.o 

SrALE*?00 # 0/<XMAX-XMlN) 

C INITILIZE arrays 

DO 6 IB=1 *12 
DO 6 IBR = 1 * 201 
NTABLFC IBB* IB)*0 
6 CONTINUE 

DATARC1 )=XMIN 
DO 1 I e 2 * ?0l 

DATARC I )=DATAB( 1-1 )+RFSOL 

1 CONTINUE 
NELAG*0 

DO 4 IC*1 *NSCANS 
NELAG2=1 

DO 2 t*nstart*nstop,ncre 

CALL GET1 (DATA.NSPS*0,NcH*NSCANO*LTN,iFRR,NFLAG2*NFLflG*NSTART 
1 NrTLG » MODE* NCR F *ITYPF*MSEC) 

GO TO f 10*999*10,10,999) »IERR 
10 CONTINUE 

DO 3 I A = 1 » NOCHS 

NCHAN = NWHICH( I A ) 

JJ=DATA(NCHAN)*SCALF+1 .0 

IE ( JJ .LT • 1 ) GO TO 3 

TF ( JJ .GT . ?0) ) GO TO 3 

NTARLFC JJ»NchAN)=NTABLF( JJ*NCHAN)+1 

3 CONTINUE 

2 CONTINUE 

4 CONTINUE 

999 CONTINUE 
REWIND LTN 

WR I TF C 6 * I 000 ) 

1000 FORMAT! 1H1 *S0X*26HPR0BABILITY DISTRIBUTION j 

1001 EORMaT(1H0*130h AMPLITUDE CH 1 CH 2 CH 3 CH - 

1 CH 5 CH 6 CH 7 CH 8 CH 9 CH 10 

71 CH 12 ) 

WRlTE(6*l00l ) 

100? FORMAT ( 1H *F9.1,l?nO) 

DO S 1=1 *?01 

WR T TF { 6 * 1002 ) DATARC!). (NTARLF<T,JJ),JJ = l f NrH) 

5 CONTI NUE 

CALL PRODFN ( NT ARLF * SCALE *GLVL »XMAX *XMTN ) 

70 RFWIND LTN 

return 

END 


CH 1 


125 


n r\ ^ 


$IRFT r PROnZ 

SUpROUT T Nr PROr>FN ( NT ARLF ♦ S'" aLf *GLVL * XMAX * XM I N 
DIMENSION NTARLE ( 201 . 1 2 ) *GLVL < 1 1 . 1 2 ) 

00 ? 1M*1 ,1? 

NT0TAL=0 

MAX=?01 

00 1 1 = 1 * MAX 

NTOTAL=NTOTAL+NTABLF( I ♦ T M ) 

1 rONTlNUF 
ntfmp.o 

GLVL ( 1 *JM )=0.0 
NCT=NTOTAL/lO 
1 1 =? 

00 2 I=2*MAX 
I J=I-1 

NT fMP=NT FMP+(NTAPLr( I J» IM )+NTARLF ( T » I M ) ) /2 
IF (NTFMP .LT. NOT) GO TO 2 

ntfmp=ntemp-nct 

GLVL ( I I. TM)=FL0AT( I J) /SCALF+XMIN-.S 

1 I * I 1 + 1 

2 CONTINUE 
GLVL(II,IM)=XMAX 

2 CONTINUE 

00 2 0 M = I ,11 

WR r T F ( 6 * 1 000 ) (C,LVL(M,MM) ,MM = l *1?) 

?0 CONTINUE 
1000 FORMAT (1X»12F6#1 ) 
return 

ENO 


SIRFTC MOO? 

sijrroutinf GLEVEL 

709A OFCK - MULTISPECTRAL SCANNFR PLOT 

OTMFNSION I ALPHA ( 20 ) 

OTMENSION IARAY(?5M 
OIMENSION IWAVF(IS) 

DIMENSION NUM(?0) ,PFRCFN( 20) 

OIMENSION XL I M ( 1 2 ) 

COMMON OATA ( 1 ? ) 

COMMON/C 1 / GLVL (11 *12) ♦NWHTCHU?) 

NAMFLTST/TNPUT2/NrH*NsPS*NsrANS*NSKlP,NSTART*NST0P, ITFRM,N, TCHAN, 

i iprt, iplt* iNcx*incy*nstx*nsty.nbtlg*mode*ncRe.ltNi IOPT 
NaMFLIST/GRYLVL/GLVL 
I N*5 
INlsiO 
I0(iTs6 
NFLAGsO 
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rv r» r» -g r> o 


NFLGPT=0 
RFWIND INI 
TALL CAMRAV(35) 

CALL BUTTV(l) 

RFAD(5*INPUT?) 

WRITF(6»INPUT?) 

DO 303 1*1 .N 

XLTMt I )«GLVL ( I * I CHAN) 

BOB CONTINUE 

RF AD (IN*GRYLVL) 

IF (IOPT ,EQ* 0) GO TO 302 

DO BO! I *1 *N 

XL !M { I ) =GLVL (1*1 CHAN ) 

30l CONTINUE 
BO? CONTINUE 

********************* 

********************* 

RFAD< IN,10?) 

READ ( IN *99 ) ( I ALPHA ( I) » I =1 * N ) *LLP 
RFAO(TN*i 09) XLOW.XUPP»(TWAVEU)*I=l*12) 

WRITFUOUT* 1 1 0 ) 

1003 FORMAT (1X*12A6*I6»5X*2F8»4) 

^00 CONTINUF 

DO 777 1=1 *N 
NUMC I ) =0 
77 CONTINUF 
KK.N-1 

WRlTF( IOUT, 106) 

WRITE (IOUT, UO) 

WR T TF ( IOUT *10?) 

WRTTF( IOUT, 106) 

WRlTPf IOUT, 103) TCHAN 

DO 7 1=1 , KK 

IF( I.FQ.l ) GO TO 9 

WRlTF (6,105) T ALPHA ( I ) ,XLTM( I) ,XLTM( 1+1 ) 

GO TO ? 

9 WRlTFt IOUT, H2) ( IWAVF(IC) .X=l, 1 2 ) » I ALPHA ( I ) ,XL iM ( I ) ,XL IM (I +1 ) 

GO TO 2 
? CONTINUE 

WRTTFC IOUT, 106) 

CALL LARFLl (NST aRT .NSTOP.NCRF) 

INUM COUNTS SCAN LINFS 

INUM.O 

IDTF=NST0P-NSTART+1 
TF (NSKIP .EO. 0) GO TO 806 
DO 805 1=1 .NSKIP 
NFL AG?=1 

CALL GFT1 (DATA, NSPS,0,Nch*NSCANO,LTN,ifRR,NfLaG2,NfLaG, NSTART, 
1NrTLG*M0DE,NCRF,ITYPE»MSFC) 

805 CONTINUE 

806 CONTINUF 
NFLAGl *0 

5 CONTINUE 
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I T N = 0 

NFL AG2=1 

205 HO 90 I!=NSTART.NSTOP 

I I N= I IN+ 1 

CALL GET 1 (DATA*NSPS» O.NCH.NSCANO. iNl * I pRR .N fL AG2 * NfL AG »NST ART * 
1 NrTLG»MODF»NcRF» ITYPE*MSFC) 

GO T0(800.80l ,800,800.801 ) .TFRR 
801 WRTTF(IOUT.IOO) NSFaNO 
GO TO 990 
800 CONTTNUF 

00 801 I = 2 » N 

TF ( OAT A ( I CHAN ) .GT. XLIM(I)) GO TO 601 
NUM( 1-1 ) =NUM( I-l )+i 
I AR AY ( I I N ) = I ALPHA ( 1-1 ) 

GO TO 90 
601 rONTTNUF 
90 CONTTNUF 

NUMT0T=TNUM*ID!F 
totnum=numtot 
totpfr=o.o 
00 888 I = l*n 

XXXNIJM=NUM( I ) 

PFRCPNl T) =(XXXNUM/T0TNUM) * 100.0 
TOTPFRrTOTPFR+PFRCPN ( 1 ) 

888 CONTINUE 
96 CONTTNUF 

T NUM = I NUM + l 

IF (TPRT ,F0. 0) GO TO 889 

WRT TF ( IOUT » 1 Oa ) NSC aNO, (IARAY(K)»K=1,IDIF)»LLP 

889 CONTINUE 

IF (IPLT .FQ. 0) GO TO 890 

CALL PLTBF1 ( IARAY* TDIF.NRLK, INCX* I NCY »NSTX*NSTY»NcRF» 

1 NFLGPT*NFLAG1 ) 

890 CONTINUE 

IF (NSCANO ,GF. NSCANS) GO TO 218 
GO TO 8 
218 CONTINUE 
NFLAG1 =0 
NFLGPT = 0 
NECANOrO 
NGTART=NGTOP+l 
NSTOP=NSTOP+IDTF 
IF ( NSTOP ,GE . NSPS) NSTOP=NSPS 
itfrm=iterm-i 
rewind ini 

WRITE ( I OUT *110) 

WRTTF ( I OUT *114) 

00 666 1=1.11 

WRiTr (IOUT. 115) I ,NUM ( I) .PfRCFN ( I ) , I ALPHA ( I) 

666 CONTINUE 

WRyTF ( I OUT *116) numtot.totpeR 

IF( ITFRM.GT.O ) GO TO 800 

98 WR I TF ( I OUT ♦ 11 0 ) 

99 FORMAT (25A1 ) 

100 FORMAT ( 1 6 I A ) 
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101 FORMAT ( 12 E 6.1 ) 
10 ? FORMAT ( ROH 


103 

104 

105 
10(S 
1 Or 
109 

no 

111 

112 

113 

114 

115 

116 
117 
999 


INTERVAL /) 


ALTITUDE 


1 ) 

FORMAT ( 2 X. 8 HCHANNEL I 2 * 36 X* 22 HSYMBOL 
FORMAT ( 5 X»I 4 » 1 X. 1 H** 120 a 1 .A 1 ) 

FORMAT( 50 XtAl* 8 X.F 6 . 1 * 3 H - ,F 6 . 1 ) 

FORMATtlX/) 

FORMAT( 10 X* 1 ! 5 A! ) 

FORMAT ( 2 E 10 . 0 . 12 A 1 ) 

F0RMaT(1H1/) 

FORMAT ( 2 X* 83 mcKOP$ C 5 - 17 . 5 - 22 . 5 - 5 . 5 - 8 * 

1 DATf RFCORDFD 6 / 30/66 //) 

FORMAT ( 2 X. 23 HWAVF LENGTH (MICRONS) . 12 A 1 , 13 X . Al * 8 X , E 6 . 1 , 
13 H - *F 6 . 1 ) 

FORMAT ( 11 X. 112 A 1 ) 

FORMAT ( 20 X. 5 HCL ASS * 7 X* 13 HSAMPLF NuMrfR • 6 X , 7 HPFRrFNT ♦ 10 X . 
112 HALPHA SYMrOL / ) 

FORMAT ( 21 X*i 2 * 10 X*t 6 » 12 X*f 7 . 2 » 15 X*a 1 ) 

FORMAT ( 20 X. 5 HTOTAL. 8 X. 16 . 12 X *F 7 . 2 ) 

FORMAT ( 3 I 4 . 12 F 7 . 3 ) 

CONTINUE 
REWIND INI 
RETURN 
END 


2000 FT. 


*IBFTC PL0TT1 

surroutinf labfli ( nstart .nstop * tncre > 

DIMENSION I OUT (120) ,J0UT (120) *KOUT< 1 20 ) *LOUT ( 1 ?D ) 

NDIF=(NST0P-NSTART+1 )/INcRE 
11*0 

DO 1 I=NSTART,NSTOP,lNcRF 
I T = 1 1 + 1 

t out ( t i ) = i /i ooo 

JOUT ( 1 1 ) = I / 100 -I / 1000*10 
KOUT ( II )=I / 10 - 1 / 100*10 
LOUT ( 1 1 ) = I-I / 10*10 
IF ( LOUT (II) .LE. 0 ) LOUT (II ) *0 
1 CONTINUE 

WRtTf (6*10) ( TOUT (T)»T*1*NdTF) 

WRTTf (6*10) ( JOUT< 1 ) ,1*1 ,NDIF) 

WRiTf (6*10) ( KOUT (I)*I=1*NDTF) 

WRtTf (6.10) (LOUT( I ) ,1*1 .NdTF) 

10 FORMAT < 1 1 X » 12011) 

RETURN 

END 


SIRFTC PLLTTl 

SUBROUTINE PLTRF 1 (ISYM,NN,NsOR,iNcx*INcY,NsTX.NsTY,NcRf. 
inflag. nflagi ) 

DIMENSION ISYM( 1 ) *NRUFER( 50 ) 

IF (NFLAG .Ne. 0 ) GO TO 10 
NSQR* 10 ? 4 /IABS(INCY+INCX) 

10 CONTINUE 
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11 

?o 


1 


? 


I F ( NFL AG 1 .NF. 
CALL FRaMFV(O) 
NCOUNTsO 
INcRXaNSTX 

incRy=nsty 


0) GO TO ?0 


NFLAG1 *1 

IF (NFL AG .FQ. 0) GO TO 11 

call aprntv ( incx.incy.nn.nbufeR.i NcRX * I NcRY ) 
tncRy*incry+incx 

TNCRX=INCRX+I ARS( INCY) 

NFLAG«l 

continuf 

NCOUNT=NCOUNT+l 
DO 1 1=1 .SO 

NRUFFRf I ) =0 
CONTINUF 


I A = 0 

DO ? I=1.NN 
I R* I A+6 
f C= I B/6 
I 0= I B-IC*6 
I F= 1 0*6 
I A= I A+l 

CALL FLD(NBUFFR( IC) .IF.6. O.lSYMdn 
CONTINUF 

CALL APRNTV ( lNrX.lNcY,NN.NRUFFR*TNcRX,lNcRY) 

incry=incry+incx 

INCRX=INCRX+I ARS( INCY ) 

IF (NCOUNT .GF. NSQR ) NFLAG1 =0 

RFTURN 

FNO 


S I RF T C GFTDAl 

SUrROUTiNf GFTKDATA*NSPS*NsKiP,NcPw.NSCAN0,iRw,IFRR,NfLaG2 , 
inflag. 

INSTaRT .NrTLG.HODE.NcRF. ITYPF.MSFC ) 

DIMENSION DATA( 1) .NDAT(890) 

DATA NFLAG/O/ 

IF (NFL AG .NF. 0 ) GO TO 1? 

NTFMP=NCPW*(NCRE-1 ) 

NSCANOsO 

NL=36-NBTLG 

NRLNG=36/NBTLG 

nflag=i 

NSTMP=(NSPS+NSTART“1 )*NCPW+MSFC*19 

NSCANSsNSTMP 

NTMP.NSTMP/NBLNG 

NSTMP=NSTMP/NBLNG*NRLNG 

IF (NSTMP # LT. NSCANS) NTMPsNTMP+1 

nscans«ntmp 

IF (NSKIP ,EQ. 0) GO TO 40? 

DO 401 1=1, NSKIP 

NSCAN0=NSCAN0+1 

CALL SKRBIN (IRW.l.RD ) 
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401 

40? 

1 ? 

13 


50 

51 

1000 


10 


• EQ. 0) GO TO 10 


CONTINUF 
CONTINUE 
CONTINUE 
IF (NFLAG2 
CONTINUE 
M*(NSTART-1 )*NCPW+MSFC*19 
IF (MODE ,EQ. 1) GO TO 50 

5« L L RF0TPR ( lRW,MOr >F*!FR R *NW.NSCANS.NDAT 
GO TO *5 1 

continue TPC ( iRw ’ MOdf » ifRR * nw * n scans,ndat 

FORMAT (IX. 16) 

NNW«NW*6 

NFLAG2*0 

N<>CANO*NSCANO+i 

CONTINUE 

DO 14 NN=l,NCPW 

IB*M+NBLNG 

iDalR/NBLNG 

IF* IB-NBLNG*ID 

IBIT«NBTLG*IF 

M*M+ 1 


) 

) 


IF (ITYPF .eo. n G0 to 15 
NDATAsO 

CALL FLD(NDATA.NL*NBTLGtIBIT»NDAT( ID) ) 
DATA(NN)=NDATA 
GO TO 14 
15 CONTINUE 
DATANsO* 0 

CALL FLd(DATaN,NL*NbTLG»IBIT.NdAT( ID) ) 

DATA ( NN ) =D AT A N 
14 CONTINUE 
M=M+NTEMP 
RFTURN 
END 


ALPHA.SYSUT2.REW 


^ORIGIN 
*IBFTC M0D3 

subroutine jontpb 

DIMENSION NKNT ( 4000 ) ,NP { 4000 ♦ 2 ) .NWKCD ( 
DATA(1?) 


1060 

1061 


DIMENSION - 750),NWKCL( 

dimension 
dimension 
dimension 
namelist 

lMODE.lTYPE.MSFC.NCREtNOJP.iMX.lMY, SCALE. BIAS 

DATA ASTRIK/1H*/ 

DATA XMARK/1HX/ 

DATA BLANK/6H / 

FORMAT ( 48X »25HDATA SWITCH HAS OCCURRED ) 

FORMAT (49X.30H JOINT PROBABILITY DISTRIBUTION ) 


750 ) 


IBI N ( 750) 

ALPNUM (47 ) .ALPHA ( 120 ) *CORDX ( 3 ) 

IMX ( 6 ) * I MY ( 6 ) 

/INPUT3/ ^H.NSPS.NSC4NS.NSMP,NSTART,NSTOP,LTN.NBTL 6 , 
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1062 FORMAT(IHl) 

1063 FORMAT (44X ♦ 1 lH X-AXjS IS ♦I6*6X*llH Y~AXTS IS *16) 

1040 F0RMaT(1H * 67H MAXIMUM PROBABILITY OF UNCOMMON AL I TY FXCEFDED - CONT 
1INUE FXCUTION ,16) 

1064 FORMAT! IX »26HSYMB0L N/SYMBOL ) 

1065 fORMaT<11X,121<1h*)*/*11X,1 H *,55X,5hPaRT ,T1,4h Of * 1 1 , 53X , 1H* ♦ / 

1 *11X*121 ( 1H*) ) 

I RT = 1 I 
NFLG3=0 
LIMI T=4000 
RFAD(5. INPUTS) 

WR I TF ( 6 * I NPUT 3 ) 

RFAD(5*1000) (ALPNUMCI) *1=1*47) 

1000 FORMAT! IX *47A1 ) 

C RFWIND I RT 

DO 80 NT I MF = 1 » NOJP 
NFLG=0 
NH = 1 
NV = 2 

IF (NSKIP ,FQ, 0) GO TO 9 

DO 8 1*1 ♦ NSK I P 

CALL SKRRIN(LTN,1 ,Rd) 

8 CONTINUE 

9 CONTINUE 
MIX=TMX(NTIME) 

MIY*IMY(NTIME) 

DO 10 1=1 ,4000 

10 NKNT C I ) = l 

WR I TF (6*1 062 ) 

WRTTF(6*1 061 ) 

WR T TF ( 6 » 1 063 ) MIX*MTY 
NCLS=1 

DO 13 MRP=1,NSCANS 

nflag?*i 

DO 15 MPR=l,NSPS 

IF (NFLG3 .GT, 0) GO TO 16 

GALL GFT2(DATA,NSPS*0,NcH*NSCaN0,LTN,ifRR*NfLAG2»NSTaRT , 
1NrTLG»M0dF.NcRf» i typf *MSFC ) 


Nr = 

DA T A ( M I X ' 

i*scalf+r 

IAS 

NR = 

DATA ( MI Y ’ 

) *Sc ALF+R 

IAS 

IF 

(NC • L T « 

1) NC= 1 


IF 

<NC .GT. 

255) NC* 

255 

IF 

(NR .IT. 

I ) NR=1 


IF 

(NR .GT. 

255) NR* 

255 

NP ( 

1 *NH ) =NC 



NP ( 

1 ,NV ) =NR 




NFLG3=1 
GO TO 16 
16 CONTINUE 

call get 2 (data»nsps*o,nch*nscano,ltn,ifRR.nflag2»nstaRt . 
1 NrTLG*MOdE»NcRF * I Type *MSFC ) 

GO TO (996*999*998*996*999) *IFRR 
999 WRITF(6*1070) NSCANO 

1070 FORMaT(33HFNd-Of-FTLF ON INPUT AT SCAN NO. ,16) 

GO TO 995 
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998 WRITF(6*1 071 ) 

1071 FORMAT (27HIRREC0VERABLE PARITY ERROR ) 

GO TO 995 
996 CONTINUE 

Nc«OATA(MIX»*SCALF+RIAS 
NRsDATA (MI Y )*S r ALE+RI AS 
IF (NC .LT. 1 ) Nr*l 

IF (NC .GT. 255) Nr*255 

IF (NR .LT. 1) NR=) 

IF (NR ,GT. 255) NR«255 

DO 1! I *1 *NCL$ 

IF (NC .NE. NP(I,NH)) GO TO 11 

IF (NR .NE, NP(I,NV)) GO TO n 

NKNT ( I ) =NKNT ( I )+l 
GO TO 18 
11 CONTINUE 

IF (NCLS .GE. LIMIT) GO TO 15 
NCLS=NCLS+1 
NP(NCLS.NH )=NC 
NP(NCLS*NV)*NR 
15 CONTINUE 

18 CONTINUE 
17 CONTINUE 

10?0 FORMAT (IX *816) 

C FIND MINIMUM AND MAXIMUM IN ROW AND COLUMN DATA 

MINC»NP ( 1 ,NH) 

MAXC*NP( 1 ,NH) 

MlNR*NP(i ,NV) 

MAXR«NP( 1 *NV) 

DC 25 1=1 * NCLS 

IF ( NP ( I * NH ) .GT* MAXC) MAXC=NP (I »NH ) 

IF ( NP ( I » NV ) .GT. MAXR) MAXR = NP ( I *NV ) 

IF (NP(I.NH) .LT. MINC) M I NC=NP ( I »NH ) 

IF ( NP ( I ♦ NV ) .LT. MINR) M I NR=NP ( I *NV ) 

25 CONTINUE 
C TEST FOR SPREAD 

ndifv.maxr-minr+i 

ndtfh*maxc-minc+i 

IF (NDIFV .GE. NDIFH) GO TO 19 
WRTTF(6*1 060) 

WRTTE(6*l068) MIY.MIX 
Nh=2 

NV=1 

ntemp.maxc 

maxc*maxr 

maxr.ntfmp 

NTFMPsMINC 

MI NC*MI NR 

MINR.NTEMP 

NTEMP.NDIFH 

ndifh«ndifv 

ndifv*ntemp 

19 CONTINUE 

WR I TF ( 6 * 1 064 ) 

C ORDER ROW DATA IN DCCENDING ORDER 
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n ri 


C BUBBLE-UP 

NSORT=NCLS 

21 CONTINUE 

DO 20 I =2 »NSORT 

IF (NP(l-l.NV) «GE. NP ( I *N V) ) GO TO ?0 
NTFMPl=NP( I-l ,NV) 

NTFMP2=NP ( I-l ,NH ) 

NTpMPl=NKNT ( 1-1 ) 

NP { I-l *NV ) = NP ( I * NV ) 

NP( I-l »NH ) =NP ( I *NH) 

NKNT( I-l ) =NKNT ( I ) 

NP ( I »NV ) sNTEMP i 
NP ( I ,NH) =NTEMP2 
NKNT ( I ) =NTEMPi 
?0 CONTINUF 

NGORT=NSORT-l 

IF ( NSORT ,GT. 1) GO TO 21 
C CALCULATE TARLF 

MAXKNT=0 
DO 2 2 1 = 1 ♦ NCL S 

22 IP ( NKNT ( I ) .GT. MaXKNT) MaXKNT =NKNT ( I ) 
NFACTaMAXKNT/45 

XXX=FLOaT (MaXKNT ) /46.0 
NFAC=0 

IF (NFACT .LT. 1) NFACT = 1 
WRtTf(6»1050) BLANK, NfaC 

nfac=nfac+nfact 

DO 23 1=1 *46 

WRjTF(6»l 050) ALPNUM( II ,NFAC 
1 0*>0 format (3X,A6.6X*I6> 

NFACsNEAC+NFACT 
CONTINUF . 

GO TO 18 
14 CONTINUE 

WRITF(6»1040) LIMIT 
GO TO 17 
18 CONTINUE 

PRINT DISTRIBUTION ON PAGF 

SET UP LOOP 

ITFRM«i 

IF (NDIFH .EQ. 120) GO TO 40 

itfrm=ndifh/i 20+1 

40 CONTINUE 
NST * 1 

NSO»NST+l 1<9 

IF (NSO ,GT. NDIFH) NSO=NDT FH 
DO 50 LOOP=l , I TFRM 
WR I TF ( 6 ♦ 1 065 ) L00P,ITERM 
CORDXd )=FLOAT (NST+M INC-2) 
C0RDX(2)=C0RDX( 1 )+60.0 
C0R0X(3 )=c0RdX( 1 )+l 10,0 
1021 FORMAT ( 1 H 1 ) 

IB = 1 

DO 60 1 1 = 1 »N0 I FV 
DO 66 1=1 t 120 
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! 


ALPHA U) .BLANK 
66 CONTINUE 

C IF ( NFLG .EQ. 1) GO TO 69 

C DO 66 I«1*NDIFH 

C ! 6 lN(n =0 

C68 CONTINUE 
C69 CONTINUE 

IF (NPIIB.NV) .NE. NAXR-II+i) GO TO 65 
I A«0 

DO 26 I * IB *NCLS 
I F* I 

IF ( NP ( I *NV ) .NE. NP ( IB»NV ) ) GO TO 31 
IA-IA+1 

NWKCD(IA)*NP(I,NH) 

NWKCL CIA) »NKNT { I ) 

26 CONTINUE 

31 CONTINUE 

IB-IE 

C ORDER X-AXIS 
NSORTalA 
NUMCLXsIA 

IF ( IA .LF. 1 ) GO TO 30 

28 CONTINUE 

DO 27 IC*2»NS0RT 

IF (NWKCDdC-l) .LF. NWKCD(IC)) GO TO 27 
NTEMP1*NWKCD( IC-1 ) 

NTEMP2*NWKCL( IC-1 ) 

NWKCDI IC-1 )=NWKCD( IC) 

NWKCL ( IC-1 )=NWKCL( IC) 

NWKCD(IC)=NTFMPi 
NWKCL ( IC ) =NTFMP? 

27 CONTINUE 
NSORT.NSORT-l 

IF ( NSORT .GE. 2) GO TO 28 
1030 FORMAT (IX »2l6 ) 

30 CONTINUE 

C IF (NFLG .EQ. 1) GO TO 91 

C I M*1 

C DO 90 1*1 .NDIFH 

C IF (NWKCD(IM) ,NF. T) GO TO 90 

C I R I N < I ) .NWKCL ( I M > 

C IM.IM+1 

C90 CONTINUE 

C91 CONTINUE 

NMl*NST+MINC-l 
DO 67 I D*1 .NUMCLX 
IF ( NWKCD < ID I ,LT. NMl ) GO TO 67 
I C* I D 
GO TO 29 
67 CONTINUE 

29 CONTINUE 
I A*0 

DO 64 I *NST *NSO 
I A* I A+l 

IF ( NWKCD ( IC ) .NF. MINC+I-1) GO TO 64 
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64 

66 


C 

70 


1008 

60 


101 1 


80 


C 

80 

C 

998 

lOlO 


XXsFLOaT (NWKCU IC) ) /XXX 
ICAR=XX+(1.001-1.0/XXX) 

ALPHA ( I A ) aALPNuM ( ICAR) 

IC=IC+1 

CONTINUE 

CONTINUE 

IF INFLG .EO. 1) GO TO 70 
WRITF(IRT) ( IBIN( I) *1=1 *NDIFH) 

CONTINUE 

CORDYsFLOAT (MAXR-I 1+1 ) 

YMARG=XMARK 

IF (NDIFV-II .NF. (NDIFV-l-I I/10*10n YM A RG=ASTRlK 
WRtTf(6» 1 008 ) cORdY.YMaRG* ( ALPHA ( I> *1=1*120) 

FORMAT ( IX *F8.1*2X*A1 *120A1 ) 

CONTINUF 

NST=NS0+1 


NS0=NST+119 

IF (NSO .GT. NDIFH) NSO=NDI FH 
WRITF(6»1 OlO) 

WR I Tf ( 6 » 1 0 1 1 ) COROX ( 1 ) *C0R0X( 2 ) »CORDX (8) 
FORMAT (6X*F10,4*50X*F10.4.40X*F10.4) 


NFLG=1 

WRITF(6*1 067 ) 

CONTINUF 
REWIND LTN 
END FILE IRT 
CONTINUE 
REWIND IRT 
CONTINUE 

format ( n ?( iOhx*********) ) 

RETURN 

END 


SIRFTC GFTOA? 

SUBROUTINE GET? ( DAT A . NSPS * NSK I P ,NcPW .NSC ANO , I Rw * I ERR , NfL AG2 » 

INST ART »NrTLg*MOdF*NcRf*ITYPf*MSFC ) 

DIMFNSION DATA ( 1 ) *NDAT ( 890 ) 

DATA NFLAG/O/ 

IF (NFLAG .NF. 0 ) GO TO 1? 

NTFMPsNCPW*! NCRE-1 ) 

NSCANOrO 

NL*36-NBTLG 

NBLNG=36/NBTLG 

NFLAG*1 

NSTMP=(NSPS+NSTART -1 ) *NcPW-fMSFC *1 9 
NSCANSrNSTMP 

ntmp*nstmp/nblng 

nstmp=nstmp/nblng*nblng 

IF (NSTMP .LT. NSCANS) ntmp=ntmp+i 
nscans=ntmp 

IF ( NSK I P ,EQ. 0) GO TO 402 
DO 401 1=1. NSK IP 
NSCAN0=NSCAN0+1 
CALL SKRRIN (IRW.1.RD ) 
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401 CONTINUF 
40? CONTINUF 
1? CONTINUE 

IF (NFLAG? .FQ. 0) C,0 TO 10 
11 CONTINUF 

M«(NSTaRT-1 )*NcPW-*-MSFC*19 
IF ( MODF .EQ. 1) GO TO 50 

CALL REDTPR (!RW*MOf)F*IFRR.NW.NScANS*NDAT) 
GO TO 51 

50 CALL REDTPC ( IRW.MODE * IERR *NW*NScaNS»NOAT ) 

51 CONTINUE 

1000 FORMAT (1X*I6) 

NNW*NW*6 
NFLAG?*0 
NSCANOaNSCANO+l 
10 CONTINUE 

DO 14 NN*1»NCPW 
IB»M-fNBLNG 
ID=IB/NBLNG 
IF»IB-NBLNG*ID 
IBI T«NBTLG*IF 

MaM+l 

IF ( ITYPF .FO. 1 ) GO TO 15 
NOATA=0 

CALL FLO(NDATAtNL*NBTLG»IBIT*NDAT( ID) ) 
OATA(NN)=NDATA 
GO TO 14 
15 CONTINUE 
DATANeO* 0 

CALL FLD(DATAN*NL*NBTLG»IBIT*NDAT( ID) ) 

DATA (NN)=DATaN 
14 CONTINUE 
M.M+NTEMP 
RETURN 
END 


sorigtn alpha*sysut?*rew 

SIBFTC M0D4 

subroutine isomet 

DIMENSION NTa(256) *NTb(256), DATA < 256 ) ,T IME ( 256 ) .DAT { 12 ) 

DIMENSION NTC(256) ♦NTD(256) 

namelist/ i nput4/ nch.nsps*nskip,nbtlg*mode»irw»nchan,nsncre,npcre, 
1 itype.msfc* 

?nptsl»nptsu* 

1MaXScN*XMiN,XMaX*YMiN,YMaX,NbLSZX.NbLSZY*N5ECT,NsM0v 

?»ndirfc 

RFAD (5*1 NPUT 4 ) 

WR I TF ( 6 * I NPUT 4 ) 

NUP*512/NBLSZY 

NBLDIR=NRLSZX*ND1RFC 

ntimfs*maxscn/nup 

CALL CAMRAV(9) 

NBACXsl 
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IF (NSKIP .EQ. 0) GO TO 33 

DO 3? 1 = 1 , NSKIP 

NFLAG2*1 

CALL GFT3 (DAT *NSPS » 0 *NCH *NSCANO, iRw* IFRR *N fLaG 2 *NPTSL .NBTLG* 
12 *NPcRF* ITYPE*MSFC) 

32 CONTINUE 

33 CONTINUE 

DO 18 MMRR=1*NSECT 

NPTSUUsNPTSU 

XMIN.FLOaT(NPTSL) 

XMAX.FLOAT(NPTSUU) 

ndiff*nptsuu-nptsl+i 

IF ( NSMOV .Nf. 0) NPTSUM=NDIFF -NSMOV+1 
NFLAGaO 

DO 16 MPR r i *NT IMFS 
IF (NDIRFC) 23*24*24 
24 IXR = 512-< 512 /NrLSZX-NUP)*NrLSZX 

I XL«0 
GO TO 25 

23 IXL=512-( 512/NBLSZX-NUP)*NBLS2X 

I X R a 0 

2A CONTINUE 
I YR*3 1 2 
IYT-0 

CALL FRAHEV(O) 

DO 10 MRP = l ,NUP 
DO 17 MMRPxi *NSNCRF 
NFLAG2=1 

CALL GET 3 (DAT *NSPS , 0 ♦ NfH *NSCAN0 , I Rw ♦ I F^K ♦ NFL AG2 »NPTSL . NRT LG ♦ 
lMOnF*NPrRF*!TYPF*MSFC) 

IF ( NFL AG .FO. 0) GO TO 19 
17 CONTlNUF 

19 CONTINUE 
NFLAG»1 

DATA( 1)=DAT (NCHAN) 

DO 1 I =2 ♦ ND I FF 

CALL GET 3 (DAT .NSPS ♦ 0 » NcH ♦ NSC ANO ♦ iRw* IFRP *N fLaG2 *NPTSL ,NRTLg » 
1 MODE *NPcRF ♦ I TYPE *MSFC ) 

DATA ( I 1 =DAT ( NCHAN ) 

1 CONTINUE 

IF (NSMOV .FO. 0) GO TO 22 
DO 20 I = l »NPT SUM 

I A= I 

IR=I A+NSMOV-1 
TFMP=0.0 
DO 21 1 1 = I A+ 1 R 

TFMP = TEMP+DATA( I I ) 

21 CONTINUE 

TFMP =TEMP /FLOAT ( NSMOV) 

DATA ( I )=TFMP 

20 CONTlNUF 

22 CONTINUE 

CALL SETMIV ( I XL * I XR * I YB • I YT ) 

CALL XSCALV (XMIN*XMAX*IXL,IXR) 

CALL YSCALV ( YM I N » YMA X ♦ I YR * T YT ) 
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DO 11 1*1 .NDIFE 
T!ME<n*FLOAT(NPTSL-l + I) 

NTA ( I ) *NYV ( DAT A( I ) ) 

NTR( I)*NXV(TlME( I > ) 

11 CONTINUE 

DO 12 I *2 *NDIFF 

CALL LINEV (NTB( I -1 ) »NTA( 1-1 ) .NTB( I ) *NTA ( I )) 

12 CONTINUE 

IF (MRP .LE. 1) 60 TO 15 
DO 13 1=1 »NDIFF 

CALL LINEV (NTd( I ) *NTC( I ) *NT p ( I ) ,NTA( I) ) 

15 CONTINUE 

15 CONTINUE 

DO 14 1*1 *NDIFF 
NTD< I)*NTB< I ) 

NTC ( I ) *NT A ( I ) 

14 CONTINUE 

IXL*IXL+NBLDIR 
I XR*I XR-NBLDI R 
I YB= IYB-N8LSZY 
IYT*IYT+NBLSZY 
10 CONTINUE 

CALL BSRFCD( lRW.NBArK.NOF) 

16 CONTINUE 
REWIND IRW 

IF (NSKIP .EQ. 0) GO TO 30 
DO 31 1*1. NSKIP 
NFLAG2=1 

CALL GET 3 (DAT .NSPS.O.NCH.NSCANO, iRw. IFRR .NFLAG2 .NPTSL .NBTLG. 
) MODE .NPrRE. I TYPE .MSEC) 

31 CONTINUE 
30 CONTINUE 

nptsu*nptsuu 

ntemp=nptsl 

NPTSL*NPTSU+1 

NPTSU«NPTSU+(NPTSU-NTEMP )+i 
IB CONTINUE 
RETURN 
END 


*IBFTC GETDA3 

subroutine GET3(DATA.NSPS.NSKIP,NCPW.NSCAN0,IRW,IERR,NELAG2. 
INST art. nbtlg. mode. ncRe. I TYPE.MSFC) 

DIMENSION DATA(l) »NDAT(890) 

data nflag/o/ 

IF (NFLAG .NE. 0 ) GO TO 12 

NTFMP*(NCRE-1 )*NCPW 

NSCANOaO 

NL*36-NBTLG 

NBLNG* 36 /NBTLG 

NELAG*1 

NSTMP= (NSPS+NSTART-1 ) »NCPW+MSFC*1 9 

NSCANS*NSTMP 

NTMP*NSTMP/NBLNG 
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NSTMP=NSTMP/NBLNG*NRLNG 

if (NSTMP .LT. NSCANS ) NTMP=NTMP+1 

NSCANS=NTMP 

IF (NSKIP ,EQ # 0) GO TO 40? 

DO 401 I=1.NSKIP 

NSC ANO=NSCANO+1 

CALL SKRRIN ( IRW* 1 »RD ) 

401 CONTI NUF 
40? CONTINUE 
1? CONTINUE 

IF (NFLAG? .EG. 0) GO TO 10 
1? CONTINUE 

M s (NSTART-1 )*NcPW+MSFC*1 9 
IF (MODE .EQ. 1) GO TO 50 

CALL RFDTPR ( IRW*MODF»IERR»NW.NScaNS»NDAT) 
GO TO 51 

50 CALL REDTPC ( I RW ,M0dF » I ERR *NW »NSCANS , NDAT ) 

51 CONTINUE 

1000 FORMAT < 1 X ♦ I 6 ) 

NNW*NW*6 
NFL AG?=0 
NSCANO=NSCANO+l 
10 CONTINUE 

DO 14 NN=1»NCPW 
I 8*M+NBLNG 

id=ir/nblng 

I F= I B~N0L NG* I D 
IBIT*NBTLG*IF 
M*M+ 1 

I F ( ITYPF .FQ. 1 1 GO TO 15 
NDATAaO 

CALL FLD(NDATA,NL*NBTLG»IBIT»NDAT( ID)) 

DATA ( NN) sNDATA 
GO TO 14 
15 CONTINUE 
DATANsO.O 

CALL FLD(DATaN.NL.NrTLG*IBIT*NDAT ( ID) ) 
DATA(NN)*DATAN 
14 CONTINUE 
M=M+NTEMP 
RFTURN 
END 


SORIGIN ALPHA, SYSUT2*REW 

$IRFTC MODS 

subroutine cntlin 

DIMFNSION DAT ( 1 2 ) 

COMMON /Lab /Ni3,Nf 3*NT3»Z(2560) ,KON<3400) ,Nl 2 ,Nf2 »NT2 ,U ( 3400 ) , 
1 V< 3400) 
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' INPUT5/ NcH » NsP S*lRW*NCHAN,NsNcRE,NPcRE,NPTSL f NPT<;u* 

?NBTLG*nODE* 

?ITYPE*MSFC* 

3NSKIP* 

1MaXScN*NSFCT* MSZX* MSZY* RLK*FHINc*ZMiN,ZMax.Lar 
RFAO (5. INPUTS) 

WRITE (6 * INPUT? ) 

CALL OPEN (IRW # d 

IXR*!024.0-8LK+.5 
I XL*0 

I YR*0 
IYT«136 
NCREaNPCRE 
NRLLK=l024#0/BLIC-f .5 
XNRLK. RUC 
FNPTSLsNPTSL 

FNPT SU*NPT SU 

NUP*MAXSCN/ ( (MSZY-) )*NSNCRE) 

NSECT*NSPS/ MSZX 

ndif.cnptsu-nptsl+i )/NPcRE 

nflagi*o 

FOIFsNOIF 

FRM« MSZY 

CALL CAMRAV( 35) 

NWDS*NCH*NSPS 
CALL BUTTV(l) 

CALL SFTMIV( I XL * I XR ♦ I YR» I YT ) 

IF (NSKIP .EO. 0) GO TO 25 
DO 26 1=) tNSKIP 
NFLAG 2*1 

CALL GET5(DAT*NSPS *0 *Nch *NSCANO * iRw * I ERR * NfL AG2 »NPTSL • 

1NbTLG*M0dE*NPcRE» ITYPE*MSFC) 

26 CONTINUE 
25 CONTINUE 
C READ(IRW) 

I I I *0 

CALL FRAMFV(O) 

DO 18 MMRR= 1 *NSECT 

npltmp*nptsl+i 

nptsuu«nptsu 

NPTSU*NPTSU“NPcRE 

NFLAG*0 

IMM.O 

DO 16 MRPP=i ,NUP 
111 = 111+1 

IF (III .LE. NBLLK ) GO TO 21 
CALL FRAMEV(O) 

1 1 1 » t 

lXR»!024.0-BLK+.5 

IXL-O 

21 CONTINUE 

CALL YSCALV (1*0 * FDI F *IYR*IYT) 

CALL XSCALV(l.O,FRM,IXL»IXR) 

DO 10 MRPal, MSZY 
IF (NFLAG1 .NE. 1 ) GO TO 20 


141 


ri n 


DO 22 IIM=1,NDIF 
I MM* I MM+1 
IMI*IMI+1 
Z( TMM).Z ( 1MI) 

22 CONTINUE 
NFLAGlsO 
GO TO 10 
20 CONTINUE 

DO 17 MMRP=l »NSNCRE 
NFLAG2*1 

1001 FORMAT (1X*16F4#1 ) 

TALL GFT5 <DAT *NSPS »0*NcH*NSCAN0,iRW*IERR*NfLaG2» np TSL* 
lNRTLG*MODF*NPfRF* ITYPF*MSFC) 

IF (NFLAG .EQ. 0) GO TO 19 
17 CONTINUE 
19 CONTINUE 
NFLAG=1 
I MM= I MM + 1 
z ( TMM)=OAT (NCHAN) 

DO 1 I=NPLTMP,NPTSUU»NPcRE 
I MM= I MM+1 

GALL GFT5 (DAT »NSPS 1 0 »Nch » NSCANO , i R w , I ERR ♦ NfL AG2 » NP TSL , 
1NRTLG.M0DF.NPCRE. ITYPf.MSFC) 

Z ( IMM)=DAT(NCHAN) 

1 CONTINUE 
10 CONTINUE 
1000 FORMAT ( 1 X*lOF1 0,2) 

CALL cONTOR (MSZY»NDTF*FHlNc*LAR»PNPTSL,FNPTSU»FRM»ZMlN t ZMAX ) 

IXL = FLOAT ( I XL 1+RLK+.5 

IXR = FLOAT ( IXR J-RLK + .5 

CALL SETMIV UXL.IXR.IYR.IYT) 

I MM = 0 

IMI=(MSZY-1 )*NDIF 
NFLAG1 =1 
16 CONTTNUF 

RFWIND IRW 
RF AD (IRW) 

nptsu=nptsuu 

NTFMPrNPTSL 

nptsl=nptsu-npcre 

NPTSU=NPTSU+(NPTSU-NTEMP )-NPCRE 
lfi CONTINUE 
9 TOP 
FND 

SlRFTr GFTDA5 

surRoutiNf gfT5 (data *nsps*nsk i p»ncPw* nscaNO, tRw* ifRR » n fLaG2 ♦ 
1 NST ART *NrTLG» MODE »NcRF* ITYPF.MSFC) 

DIMENSION DATA( 1 ) »NDAT( 890) 

DATA NFLAG/O/ 

IF (NFLAG .NF. 0 ) GO TO 12 
NTFMP=(NCRE-1 )*NCPW 
NSCANOsO 
NL = 3f)-NRTLG 
NRLNG*36/NBTLG 

nflag=i 
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NSTMP*<NSPS+NSTART-i ) *NCPW+MSFC*19 

NSCANS»NSTMP 

NTMP.NSTMP/N8LNG 

NSTMP«NSTMP/HBLNG*NRLNG 

IF ( NSTMP .LT . NSCANS) NTMP.NTMP+1 

NSCANS-NTMP 

IF (NSKIP .EQ. 0) GO TO 4 O 2 
00 401 1*1 *NSKlP 
NSCAN0*NSCAN0+1 
CALL SKRBIN ( IRW* 1 *RD ) 

401 CONTINUE 
40? CONTINUE 
1? CONTINUE 

IF (NFLAG2 .FQ. 0) pO TO 10 
n CONTINUE 

M*(NSTART-1 )*NcPW+MSFC # 19 

IF (MODE .EQ. 1 ) GO TO 50 

CALL REOTPR ( IRW.MOOE . IERR .Nw.NSCANS.NDAT ) 

GO TO SI 

50 i-aLL REOTPc ( lRW»MODE*IFRR»NW*NSCANS*Nr>ATl 

51 CONTINUE 

1000 FORMAT ( 1 X • I 6 ) 

NNW=NW*6 
NFLAG?*0 
NSCANO.NSCANO+1 
10 CONTINUE 

00 14 NN=1,NCPW 

ib*m+nblng 

ID*IB/NBLNG 
IF*IR-NBLNG*ID 
IBI T*NBTLG*IF 

IF ( ITYPF .EO. 1 ) GO TO IS 
NDATA=0 

CALL FLD<NOATA*NL*NpTLG*TRIT»NdaT( in) ) 
OATA(NN)=NDATA 
GO TO 14 
15 CONTINUE 
DATANsO.O 

CALL FLD ( DATAN.NL »NBTLG» I BIT.NDAT( 10) ) 

DATA (NN ) rOATAN 
14 CONTINUE 
MaM+NTEMP 
RETURN 
END 


5 IBFTC CTOR 

SUBROUTINE CONtOR ( L »M . FH I nc.lab.fnptsl .FNPTSU .FRM. zMl N.zMAX ) 
DIMENSION I(5).Vl(^).V?(S)*Pl(S)*P?(S).X(S)*Y(Sl 

DIMENSION VS(S) 

COMMON /LAB /Nr 3 ,Nr3 ,NT3 .2 ( 2560 ) .KON ( 3400 ) , N T 2 ,Nf2 ,NT2 ,U ( S400 > . 
1 VM400) 

LOGICAL JCOOF 

IF (M.GT.O.AND.L.GT.O.ANO.FHINC.GT.O • 0. AND. LAB .GF. 0 ) GO TO 1 
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WRITF ( 6 * 1 Ol ) M,L*FHINC 
RFTIJRN 
1 NaR400 

Nr=(ZM4X-ZMlN)/ARS(FHTNC) 

FH*ZMTN 
? CONTI NUF 

NLAB=LAB-1 

IF (LAB .FQ. 0) NL AR=LAB+1 
00 IF IH=1 »NC 
NT ?** 

NF?aF 

NT?aF 

V( ? ) bFNPTSU 
U(?)aFRM 

Y ( 4 ) aFNPTSL 
U ( 4 ) = 1 . 0 
<*I 

NL4B=NLAB+1 

IF (NL4R .NF. LAB) CO TO FI 
Ka? 

NLAR=0 

FI DO 10 IL =2 » L 

00 1 0 " IMa? »M 

I (R) = ( TL-l )*M+TM 
I ( ? ) =1 ( R )-l 

1 ( 4 ) a I ( R ) -M 
I M ) * I ( 4 ) ~ 1 
i (F)*m ) 

X(1 )=IM-1 

X (?) a I M— 1 
X ( R ) a I M 
X ( 4 ) a I M 
X ( F ) a I M- 1 
Y ( 1 ) aIL-1 

Y ( ? ) a I L 

Y ( R ) a I L 

Y ( 4 ) = I L — 1 
Y ( F ) a I L — 1 
IZ?aI (?) 

izi = m ) 

IZRal (R) 

IZ4aI (4) 

T 7 Fa T ( F ) 

1000 FORMAT (1X»?F10,?*TM 
VI (1 )a(X ( 1 )+X (4) ) /? *0 

vi ( ? ) = ( Y ( 1 )+Y (?) ) /? ,0 

Vl(R) = (Z(lZl)+Z(TZ?)-fZ(lZR)+Z(lZ4))/4.0 
DO 4 J = 1 » 4 
I Z a I ( J ) 

V? ( 1 )aX( J) 

V?(?)aY( J) 

V? ( R ) aZ ( TZ ) 

I Z a I ( J+1 ) 

VR ( 1 )aX( J+1 ) 

VR(?)aY( J+1 ) 


144 


V8i8)*Z( 1 2 j 

TP (V2(3) ,LF. 0,0 .AND, V3(3) ,L£. 0.0) GO TO 4 
NV?=V?<8 )♦.«> 

NV8=V8 (8 ) + ,5 

TF (NV? ,F0. NV3) GO TO 4 
100? FORMAT (1X»3F10.2) 

TALL STRlKF(Vl.V2.V3.FH»Pl.P2*IFR) 

IF (IFR ,NF. 2) GO TO 4 
IF (NF2+2 .LF. N) GO TO 59 
WRTTF (6*100) FH*N 
GO TO 60 
*iO NF?=NF?+? 

U( NF2-1 )=Pl (?) 

VINF2-1 )*Pl ( I ) 

ICON I NF2-1 ) =0 
U ( NF ? ) =P? f ? ) 

V(NF2)=P?d ) 

ICON ( NF2 ) =1 
4 CONTINUF 
10 CONTINUF 

60 IF (NI? ,GF. NF2 ) GO TO 15 
JCODFs.TRUF, 

DO 61 J=N I 2 *NF? 

JTFMPsJ 

DO 61 JJ=2*4*2 

IF <U(J) ,FQ. U ( JJ ) ) GO TO 68 
IF <V(J) ,F0. V( JJ) ) GO TO 68 

61 CONTINUF 
NT?*NT?+? 

U( NT 2-1 ) sUINf? ) 

VINT 2 - 1 ) =V (Nr?) 

K0NINT2-1 ) =0 
U ( NT? ) *U ( N I 2+1 ) 

V { NT ? ) *V ( Nl ?+l ) 

•CON ( NI ? ) =1 
NI?=NI?+? 

GO TO TO 
68 JxJTFMP 

IF (ICONtJ) ,F0. 0) GO TO 6? 

JJaJ-1 
JMAX=J 
GO TO 68 
6? JJ=J+1 
JMAXaJJ 

68 Vld)aU(J) 

VI ( ? ) *V( J ) 
v?n ).u( JJ) 

V?(2)sV( JJ) 

JDIF=JMAX-NI?-i 
DO 64 JSUB=1 ♦ JDIF 
JDFX=JMAX-JSUB+1 

kdfx=jmax-jsub-i 

U( JDFX)aU(KDFX) 

64 VI JOFX)aV(KDFX) 

NI?«NI?+? 
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IF (JCORF) GO TO 7? 

nt?=nt?+i 

U(NT?)=V? ( I ) 

V(NT*)»V?(?) 

KON ( NT? ) =1 
GO TO 70 
17 NT ?=NT 7*7 

U ( NT 7 ~\ ) *Vl ( 1 ) 

V ( NT 7 -} )*Vl (?) 

KON(NT?-1 ) =0 
U(NT?)*V? ( I ) 

V(NT?)rV? ( 7 ) 

KON ( NT? ) s 1 

70 IF (NI2 .GF. NF2) GO TO 16 
DO 71 J = N I ? »NF? 

JTFMP=J 

IF (U(J).NF.U(NT?) # OR.V( J).NF.V(NT?) ) GO TO 71 
jrODP=. FALSE. 

GO TO 6R 

71 CONTINUE 
GO TO 60 

16 rONTTNUF 
NCNTaO 
J I *6 

DO BO J=6 *NT? 

JJ = J 

IF ( KON ( J ) .FQ. n GO TO B1 
IF (NONT .GT. 4) GO TO 71 
DO 77 JI J = JI , JJ 
KON ( JI J ) =0 
77 CONTINUE 
7? NCNT=0 
JI=J 

GO TO BO 

^1 ncnt»ncnt+i 
70 CONTTNUF 

IF (K .NF. ?) GO TO B01 
CALL LABFL(FH) 

BO l CONT I NUF 

DO BOO J=6 *NT ? 

Jl)L=NXV(U( J) ) 

JVL»NYV(V( J) ) 

Jl)RsNXV(U ( J+l ) ) 

JVR=NYV(V( J+1 ) ) 

r WRtTF (6*1 00? ) JUL * JVL » JUR ♦ JVR 

lOOB FORMAT ( IX *416 ) 

IF (KON(J+l) .NF. 0) CALL L I NFV ( JUL , JVL ♦ JUR ♦ JVR ) 

BOO CONTINUE 
15 FW = FH4-FHINC 

100 FORMAT (45H WARNING IN SURROUTINF CONTOR AT A HEIGHT Of * 
1F7.1 , 

246HNUMRFR OF POINTS FXCFFOFO ALLOWARLF NUMRFR OF ♦ 

I 5 » / ♦ 

421HFXFCUTION CONTINUING »//) 

101 FORMAT ( 28h FRROR IN SURROUTtNF cONTOR * / 1 1 1 * 
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121H=NUMBFR Of GRID ROWS ./.111* 

224H=NUMRFR OF GRID COLUMNS */»F11.3* 
333m=DISTaNCF RfTWFFN CONTOUR LARFLS ./♦Til* 
42PH=FRFQUFNCY of contour larfls */» 
521MFXFCUTTON TfRMINaTFO *// 1 

RFTURN 
FND 


$ IRFTC STRK 

SUrROUTtNf STRtKF(V 1 *V7*V3*FH»Pl »P2.TFR) 

nyMCNSTON VI ( 1 ) *V2 (1 1 *V3 ( 1 1 *Pl ( 11 *P2 ( 1 1 *Q ( 3 .3 1 

DO 6 1=1 * 3 

Pi ( 11=0.0 

P2( I 1=0.0 

Of I *1 1=V1 (II 

Q ( ! » 2 1 =V ? ( I ) 

6 Q(I.3i=V3(Ii 

1000 FORMAT ( 1 X * 3F1 0.31 
DO 7 1=1,7 
11 = 1 

DO 1 J= T I » 3 

IF ( 0 ( 3 , T I 1 -Q ( 3 . J ) l 1,1,2 
2 DO R L= 1 ,3 

A=0 ( L * 1 1 1 
Q ( L , 1 1 1 *Q ( L , J 1 
0(L, J)=A 
n CONTiNUF 

1 CONTINUF 

7 CONTINUF 
!FR=0 

I F ( 0 ( 3 , 3 1 .LT .FH.OR. 0(3*11. OT.FH1 RfTURN 

IF (0(3,1 1 .FQ.FH.AND.O(3,2 1 • FQ. FH. AND.Q ( 3 , 3 1 .EQ.FH1 RETURN 
A= ( FH~Q ( 3 » 1 11/(0(7,11-0(7*711 
Pi ( 1 ) = (Q ( 1 * 1 1~0( l ,3 } ) *A-fO ( 1 *1 . 1 
Pi (?l=(Q(2»1 1 — Q (7,3) ) *A+0 (2*1 1 
Pi ( 3 1 = FH 

IF (0(2*1 1 .NF. FH 1 GO TO 7 
IF (0(3.2 1 .NF. FH 1 GO TO 4 
P7(l 1=Q(1 *21 

P 7 ( ? 1 =0 (2*21 

P7 ( 3 ) *Q ( 3 , 7 ) 

I FRs? 

RFTURN 

3 IF (0(3*71 ..GT. FH 1 GO TO 3 

A= ( FH-0 (7*21 )/(Q(3*7) -0(7,711 
P7(11=(0(l»7)-0(1*71 1 *A+Q ( 1 *71 
P2(71=(Q(7»71-Q(2*7) )*A+Q(?,7) 

P 7 ( 7 ) =FH 
I FR*7 
RFTURN 
4 I FR= 1 

P7 ( 1 1 =P 1 (1 1 
P7(?1=Pl (2) 

P? ( 3 1 =FH 
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RETURN 

*5 A=(FH“Q(7»1 ) )/ (0(3*1 )-Q(3»?) ) 

P?nislQ(l*l)-Olt»?) )*A+Q( 1 * 1 ) 
P2( 2 )=< Q( 2*1 }-Q( 2*2 1 )*A+Q( 2*1 ) 
P2 ( A ) sFH 
I FR = 2 
RETURN 
FND 


SIRFTC MARK 

SUPROlJT I NF LARFL(H) 

rOMMON /LAR /Ni3*Nf3*NT3*Z (2560) ,KON(3400) ♦ N I 2 ♦ Nf2 *NT2 *U < 3400 ) * 
1 V( 7400 ) 

12*5 

l? 11 = 12+1 

D I S = 0 , 0 

is=n+i 

IF (Tl+4 .GT. NT 2 ) GO TO 99 
DO 10 I2=IS*NT? 

IF ( KON ( 12 ) .FQ. 0) GO TO 11 

10 Of S=r>iS+SQRT ( ( U < T 2 ) -U ( I 2~1 ) ) **2+ ( V ( I 2 ) -V ( I 2~1 ) )**?) 

11 112 = 12-1 

TF (DIS .LT. 270.0) GO TO 12 
I M= ( 1 1 2+ II )/2 
TOT F= ( 1 1 ?-1 1 )/? 

IF ( TDIF .LT. 2) GO TO 12 
DO 20 J=l » ID I F 
I L= I M-l 
1 1)= I M+J 

niS*SQRT( (U( I U i -u ( ID )**?+( V( IU)-V( IL) )**?) 

IF (DIS .GT. 68.0) GO TO 16 
20 GONTINUF 
GO TO 12 

16 I 9 = I L + l 

DO 19 JJ= I S * IU 
10 KON ( JJ ) =0 

RFALM=10.0F+1 o 

TF (U(IU)-U(lL) .Nf. 0.0) RfaLM= (V( IU )“V( IL) ) /(U( IU)~U( IL) ) 
ANGL=ATAN(RFALM) 

R=(DTS-68.0) /2.0 
S = 6P . 0+R 

TF (U(TU) .GT. U ( I L ) ) GO TO 70 
1 1 * I U 
I U* I L 
I L = 1 1 

30 XP = (R*U( I U )+S*U ( T L ) )/DTS+6.8 # SIN(aNgL) 

YP=(R*V( IU)+S*V( IL) )/DlS-6.fi*cOS( ANGL ) 

DO 18 JJ=1,8 
ND=5-JJ 

IF (ARS(H) .LT. l0.0**( JJ-1 ) ) GO TO 17 
18 CONTINUE 

17 CONTINUE 
IXP*XP 
IYP=YP 
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CALL LABLV(H.IXP,IYP,ND» 1 » 5 ) 
GO TO 17 
99 RETURN 
FND 


SORiniN ALPHA.SYSUT2.RFW 

5IRFTC MODS 

subroutine bwndrs 

DTMFNSION x ( 12.256 ) .Y (I 2,256 ) .MchANC 1? ).NN( 756) »KSYM(49) » JSYM( 

1756) 

DTMFNSION NWHICH(17) 

N ft MPLTST/TNPUT6/NSr&NS.NSTflRT.NSPS,NcH.NVAR.NSYM,iSUM,NqTLr 1 . 
1 MOoF.ITYPf.MSFC * n SKiP.NbLK, iNcX. INcY.NSTX.N5TY.NcRf 
NaMELIST/NCHUSf/NWhTCH 
EQUIVALENCE (N SC AN, N SCANS) 

EQUIVALENCE (NSTRT.NSTART) 

EQUIVALENCE (NCOL.NSPS) 

EQUIVALENCE (NCHAN.NCH) 

I CARD* 5 
IPR!NT=6 
INTAPE=10 
I0TAPE=11 

RFADUCARD.INPUT6) 

WRTTF (IPRINT.INPUT6) 

RFADUCARD.NCHUSE) 

WRTTF(IPRINT.NCHUSF) 
l FORMAT ( 1 X , 7 I 4 ) 

5 F0RMATI1X.17I1 ) 

RFAD< I CARD. 5) (KSYM ( T ) . t *1 ♦ NSYM $ 

5 FORMAT(1X,60A1 ) 

NFLAG=0 

A VF s I SUM 

APOPsO.O 

DXAVFsO.O 

DYAVFaO.D 

DZAVFaO.O 

NSAV.NSCAN 

IF (NSKIP .EQ. 0) GO TO 98 

DO 97 1 = 1 .NSKIP 

CALL SKRBINt INTAPE, 1 , NOP) 

97 CONTINUE 
9fl CONTINUE 
7 FORMAT f 1 HI ) 

4 FORMAT ( 5X » 1 1 1 II ) 

11*1 

KK=NSTRT-1 

160 IF( IT.EQ.NSCAN) GO TO 510 
11 = 11+1 
NFL AG7=1 
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I F ( II.NF.2) G 0 TO 0 
DO 170 JJ=l,NCOL 

TALL GET 6 (X ( 1 » JJ) *NrOL »0 *N(*HAN,NSrANO. iNjaPf* jpRR ,NfLa ^2 »NSTRT * 
1NrTLG»M0DF*NcRF»ITYPF»MSFC) 

170 CONTINUE 
700 CONTINUE 
NFL AG?=1 

DO 700 JJ = 1 * NCOL 

CALL GET 6 ( Y ( 1 * JJ) »NrOL .0 *NrHAN ,NSCANO, iNjaPf , I fRR .NfLaG2 »NSTRT * 
1NRTLG*M0DF*NCRP* ITYPF»MSFC) 

700 CONTINUE 

DO 7R0 J J = 2 »NCOL 
I J= J J-l 
XSUMsO.O 
Y 71 IM = 0.0 
ZSUMrO.O 

DO 760 TCHAN=1,ISUM 
I I CH N = NWH I CH ( I CHAN ) 

XDTFF=Y( T I CHN ♦ J J ) -Y ( I ICHN» I J ) 

YDI FF=Y ( T ICHN» JJ )-X( I TCHN, JJ ) 

XSUM=XSUM+XDIFF*XOIFF 
YSUM=YSUM+YDIFF*YDTFF 
Z7UM=ZSUM+XDIFF*YDTFF 
RAO CONTINUF 

XSUMsXSUM/AVF 

YSUM 3 YSUM/AVF 

zsum*zsum/avf 

AP0P=AP0P+1 .0 
AA*1 .O/APOP 
RR=1 ,0-AA 

dxavf=rr*dxavf+aa*ysum 

DYAVF=RR*DYAVF+A A*X5UM 
DZ AVF=RR*DZ AVF+A a*zsum 
X SUM* SORT ( XSUM ) 

IF (XSUM .LT. S 7 . 4 ) GO TO 765 
764 XSUM=57.0 

YSUM*S7.0 
GO TO 766 
76R CONTINUF 

Y SUM* SORT ( YSUM ) 

IF (YSUM .LT. 57.4) GO TO 766 
GO TO 764 
766 CONTINUF 

CALL JNTPB(YSUM,XSUM,NFLAG*0.0.KSYM(7) *NPOP. 

7DXAVF »DYA VF » 

■»R7 A VF , 

1 JJ, NSC AN, II ,NC0L,JSYM,X,NSTRT,NN, INCX ) 

NSC AN = NS AV 
RRO CONTINUF 

DO 500 JJ=l ,NCOL 
DO 4P0 TCHAN=1,ISUM 
I I CHN = NWH I CH ( ICHAN) 

X ( T ICHN, JJ ) =Y ( I I CHN , JJ) 

4Q0 CONTINUE 
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*00 CONTINUE 
GO TO 160 
510 CONTINUE 
NFLAGal 

CALL JNTPB(YSUM,XSUM,NFLAG*0»0*KSYM(*) ,NPOP, 
?DXAVF*DYAVE * 

BD2AVF, 

1 JJfNSCANtI ! »NC0L, JSYM.X »NSTRT*NN, INCX ) 

RFWIND IOTAPF 
REWIND TNTAPF 
C CALL CLEAN 

return 

END 


STRFTC PL0TT6 

SUBROUTINE LARFL6(NSTART,NST0P»INCRF 
DIMPNSION IOUT(1?0) 
NDTF*(NST0P-NSTaRT+1 ) / t ncrf 
11*0 

DO 1 I=NSTaRT»NSTOP,INcRE 
11 * 11+1 

TOUT ( 1 1 ) *1 /I 000 
1 CONTINUE 

WRTTF (6*10) (TOUT( T ) ,1=1 ,NDTF) 

11*0 

DO 7 I*NSTART.NSTOP,!NCRE 
!!=!!+! 

ioutu n*i zioo-i /i 000*10 

7 CONTINUE 

WRtTF ( 6 » 1 0 ) ( IOUTC 1 ) ,1 = 1 ♦NOTF) 

1 1 *0 

DO 5 I=NSTaRT,NSTOP,INcRF 
11 * 11+1 

i out ( i i ) =i / io-T / 100*10 
* CONTINUE 

WRTTF (6*10) ( T OUT (T)*T = 1*NDIF) 

11*0 

DO 4 I=NSTART,NSTOP,INCRE 
11 * 11+1 

I OUTCII). 1-1/10*10 
IF ( TOUT (II) .LE. 0 ) T0UT(T!)*0 
4 CONTINUE 

WRITE (6*10) (T0UT(T),i*1»NDTF) 

10 FORMAT ( 1 1 X . 12011) 

RETURN 

END 


tIBFTC 0FTDA6 

SUBROUTINE C,FT6(DATA.NSPS*NSKtP,NcPw*N5CAN0,iRw,IERR.NfLaG2* 
INSTART ♦NpTLG*MODF*NcRF*!TYPf > MSFC ) 

DIMENSION DAT A ( 1 ) *NDAT ( 890) 

DATA NFLAG/O/ 

IF ( NFL AG .NF. 0 ) GO TO 1? 
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N5cano=o 

NTFMP=CNCRF-1 )*NCPW 
NL=5*-NRTLG 
NRLNG=56/NBTLG 
NFLAG=1 

NSTMP=(NSPS+NST ART-1 )*NCPW+M$FC*19 

ngcans=nftmp 

ntmp*nstmp/nblng 

nstmp=nstmp/nblng*nrlng 

if (NSTMP ,LT. NSCANS) NTMP=NTMP+i 
NSCANSsNTMP 

IF (NSKlP .FQ. 0) GO TO AO? 

DO 401 I =1 * NSK I P 

NSfANO=NSCANO+l 

CALL SKRBIN ( I RW * 1 ,RD ) 

40i CONTI NUF 
40 ? CONTINUF 
1? CONTINUF 

IF ( NFL AG? .FO. 0) GO TO 10 
1? CONTINUF 

M={NST ART- 1 )*NfPw+MSFC*19 
IF (MODF .FO. I) GO TO 50 

CALL RFDTPR ( irw»mode»ieRR»nw*nscans*ndat) 

GO TO 51 

50 r#LL RfoTPC ( TRW»MOnF,TFRR»NW»NSCANS»NDAT ) 

51 CONTINUF 

1000 FORMAT ( I X * 1 6 ) 

NNW=NW*6 
NFL AG?=0 

nscano=nscano+i 

10 CONTINUF 

DO 14 NN=l*NCPW 

IR=M+NRLNG 

id=tr/nrlng 

IF=IR-NRLNG*ID 

trit=nrtlg*if 

MrM+ I 

IF ( ITYPF .FQ. 1) GO TO 15 
NDAT A = 0 

GALL FLd(NDATA »NL »NrTLG* TRIT ^DAT ( TO ) ) 

DATA (NN) = ndat A 
GO TO 1 U 
1R CONTINUF 
DAT AN = 0, 0 

CALL FLO ( DATAN.NL » NRTLG ♦ I R I T ♦ ND AT ( ID) ) 
DATA(NN)=DATAN 
14 CONTINUF 
m=m+ntfmp 
RftuRN 
FND 


SIRFTC JOINT 

SURROUTINF JNTPR(DATAH»DATAV»NFLAG»MI X*Ml Y » ALPNijM.NPOP , 
?DXAVF,DYAVF» 
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^D? A VP * 

IJJ.NScaN.T ScaN *NrOL * I SYM .NX » NSTRT *NN ♦ iNcXY ) 

DIMENSION INfXYf 1 ) 

DIMENSION NP(54*54) 

DIMENSION DATAd?) 

DIMENSION IBIN(?55 ) 

DIMENSION ISYM(I) ,TQUIT(tOO) 

DIMENSION NX(1 ) *NN ( I ) 

DIMENSION ALPNUM! 1 ) .aLPHA(1?0),cORdX(3> 

DOUBLE PRECISION A ( ? *2 ) .EIGFN ( 2 »2 ) 

INTEGER ALPNUM, ALPHA .BLANK 
DATA ASTRlK/lH*/ 

DATA XMARK/1HX/ 

DATA BLANK/6H / 

DATA NFLAG4/0/ 

1060 FORM A T (48X*25HDATA SWITCH HAS OrcURRFD ) 

1061 FORMAT ( 49X * 3 OH JO I NT PROBABILITY DISTRIBUTION ) 

106? FORMAT ( 1 HI ) 

1063 FORMAT ( 44X * 1 1h X-AXTS IS .T6.6X.11h Y - AXlS IS ,216) 

1066 FORMAT <30X*6hDXAVF**f15.7,6hDYAVF=.F15.7,6hDZAVF=.f15.7 ) 

1040 format ( ih *67h maximum probability of uncommonality exceeded - font 

1 INtJE EXCUT I ON »?I6) 

1064 FORMAT! IX *26HSYMB0L N/SYMBOL ) 

1065 F0RMaT(11X,121(1h*)*/,11X,1h*»55X*5hPaRT ,U,4h Of , T 1 , 5 3X . 1H* * / 

1 .11X.121C1H*)) 

IF ! NFL AG4 .GT. 0) GO TO 80 
NFLG3=0 

1000 FORMAT (1X*47A1 ) 

NFLGaO 
N I = ? 

I RW= 1 
NFLGEN=0 
IRT = n 

DO 1 1=1,54 

DO 1 J=1 » 54 
NP ( I * J ) =0 
1 CONTINUE 

REWIND IRT 
REWIND IRW 
NFLAG4=1 
80 CONTINUE 

TF (NFLAG.GT. 0) CO TO 13 

NCaOATAV+1.5 

NRsDAT AH+1 • 5 

IF (NC .LT. 1) NC=1 

IF (NR .LT. 1) NR=1 

NP ( NR , NC) =NP ( NR , NC ) + I 

I s84* ( NC - I M-NR 

IBTN! JJ)aI 

IF (JJ .LT. NCOL) GO TO 15 
TBTN(1 )alBIN(?) 

WRITE! IRW) (IBIN! IT ) ,1 1 = 1 .NCOL) 

15 CONTINUE 
RETURN 

13 CONTINUE 
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17 CONTINUE 

REWIND TRW 
I OPT *! 

IN»? 

IMa? 

RhO= 1 ,0/ ( l0.0**6 ) 

A (1.1 ) =DX AVE 
A (7* 7 ) =DY AVE 
AH ,2)=D7AVF 
A(2»1 )=07AVF 

ran dJeOri (a»iM»in»iOPT , RhO »eRR » ftgeN ) 

r WRrTr(6»l067) A< 1 »1 ) »A< 1 *2 ) *FTGFN< 1 ,1 ) »E!GFN< 1 ,2 ) 

C WR T T r ( 6 * 1 067 ) A ( 2 * 1 ) * A < 2 * 2 ) • El GEN ( 2 ♦ 1 ) ♦ FIGFN ( ? , 2 ) 

1067 FORMAT (1X»2E15«7»10X»2E15«7) 

DXAVE=1 . 0/ A ( 1,1) 

DYAVF=1.0/A(2»2) 

A ( 1 » 1 ) =E T CFN ( 1 » 1 ) *P»X AVE 
A( 1 ,2)=EIGFN(2»1 )*DXAVF 
A (2»1 )=ETGEN(1 , 2)*DYAVF 
A(7»?)=EIGEN(2*2)*DYAVE 

DXaVE = EIGEN ( 1 » 1 )*A( 1 »1 )+EIGFN( 1 »2)*A( 2,1 ) 

DYaVE=ETGEN(2»1 ) *A ( 1 »2)+EIGEN(2»2)*A(2»2) 

DZaVF=FTGEN( 1»1 ) * A ( 1 »2)+EIGFN( 1 ,2)*A( 2,2 )+FTGFN( 2, 1 )*a (1,1) 
1+FTGFN(?,?)*A (2,1 ) 

WR T T F ( 6 , 1 066 ) DXAVF ,DYaVF ,D2 AVE 
1=0 

DO 1 70 NC = 1 ,64 
DO 170 NR = 1 ,64 
1 = 1 + 1 

IE ( NP ( NR » Nc ) .EO. 0) GO TO 170 
XXX=NR*NR 

yyy=nc*nc 

Z?7=NR*NC 

sum=hx avf*xxx+dy avf*yyy 

1 +r>7 A VE*ZZ Z 

IF ( SUM. GF. 1.0) GO TO 116 
NX ( I ) =0 
GO TO 170 
116 NX ( I ) =-1 
1^0 GONTINUF 

WRITE (6,1062) 

WR TTF ( 6,1 061 ) 

WR T Tf ( 6 » 1 066 ) DXAVF ,DYAVE ,DZ AVF 
WRlTF(6,1 064) 

C CALCULATE TABLE 

MAXKNT=0 
DO 22 NC = 1 * 67 
DO 22 NR = 1 ,67 

TF (NP(NR,Nr) ,GT. MAXKNT) MAXKNT=NP(NR»Nr) 

27 CONTINUE 

IF (MaXKNT .LT. 46 ) MAXKNT=46 
NEACT=MAXKNT/46 
XXX=ELOAT (MaXKNT) /46.0 
NE AC = 0 

IF (NFACT .LT. 1) NFACT = 1 
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WRTTe(6*i0s0) RLANK.NfaC 

NFAC*NFAC+NFACT 
00 2^ 1*1 *46 

WRtTf(6*1050) ALPNUMf I ) »NFAf 
1050 FORMAT ( 3X • A6 *6X * 1 6 ) 

nfac=nfac+nfact 
23 rONTINUF 

WRITF(6*106?) 

r PRINT OTSTRIRUTION on pagf 
roRoxn 1*0.0 

C0R0X<2)=C0R0X(l 1+60.0 
'“OR OX ( 3 1 =CORf)X (ll + llO.O 
1 021 FORMAT ( 1 H 1 1 

00 65 IFN0=1*54 
NC=66-IEND 
00 66 1=1 *54 
ALPHA ( I 1=RLaNK 
66 CONTINUE 

IF ( NFLG • EQ. 11 GO TO 69 
00 68 1=1*54 
T R T N C I )sO 

68 CONTINUE 

69 CONTINUE 

00 64 NR=1 .54 
XX=ELOAT (NP(NR,NC1 1 
IF (NFLG .FQ. 11 GO TO 91 
IRTN(NR)=NP(NR.NC1 
91 CONTINUE 

ICAR=XX+( 1 .001-1 .O/XXX ) 

IF I ICAR • GT . 46 1 !CAR=46 
ALPHA(NRi=ALPNUM( ICAR) 

64 CONTINUE 

rOROY=ELOAT(NC) 

ymaRg*xmaRK 

IE <NC .NE. 54-IENO/10*l Oi YMARG* ASTR I K 
WR T Tf ( 6 ♦ 1 008 ) CORDY,YMARG*( ALPHA! I 1 *1=1*54) 
1008 FORMAT (1X*E8.1»2X»A1 » 1 20A1 ) 

66 CONTINUE 

WRITE(6*1 0 1 0 ) 

WRlTc(6»l0n ) rORoxn ) *cORnX( 2 ) *cORnX(A) 
1011 FORMAT <6X*F10.4,50X*C10.4,40X*F10.4) 

nflg*i 

WRlTF(6.1 062} 

NSUB* 1 
LWFR*1 
LOW*NSTRT 
706 CONTINUE 

NHI*L0W+1 20-1 

N1JPPFR*LWFR+1 20-1 

IF (NUPPFR .GT. NCOL) NUPPFR=NCOL 

WR I TF ( 6 » 1 062 1 

CALL LARFL6(L0W*NHT *1 ) 

00 131 1 1 =N I ,N$CAN 
RFAO(lRW) ( IR I N ( JJ) ,JJ=i ,Nc0L) 

00 1*5 JJ* 1 *NCOL 
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Icmfck=tbtN ( JJ ) 

JCHFCK=NX ( I CHECK ) 

! F ( JCHFCK ,NF. 0) GO TO 117 
ISYM( JJ)=ALPNUM(NSUR“1 ) 

NN ( JJ ) =0 
GO TO 135 

117 I SYM ( JJ ) sALPNUM ( NSUB ) 

NN(JJ)=-1 
1?^ CONTINUE 

IF (NFLGFN ,NF. 0) 00 TO 136 
WRtTF(IRT) ( NN ( JJ ) » JJ = 1 *NCOL) 

call PLTPF6 ( TSYM,NrOL,NBLK,TNcXY(l ) ♦lN('XY( 2) »lNrXY( 3 ) » 
1 INCXY(4) ♦ NcRF ) 

136 CONTINUE 

WRlTF(6» 1 03 6 ) 1 1 ♦ ( ISYM( JJ ) , JJ=LWER *NUPPER ) 

1036 FORMAT ( 5X * I 6 * 1 20 A 1 ) 

1 0 3 ^ FORMAT ( 1 X * I 6 ) 

131 CONTTNUF 
NFLGFN=1 
REWIND IRW 

lwfr=nupper+i 

LOW=NH I +1 

IF (NUPPER .LT. NCOL) GO TO 705 
9P5 CONTINUE 

lOlO FORMAT ( 11 X ♦ 1 7 ( 1 OhX # ******** ) ) 

NPLGFN=0 

RETURN 

END 


SIBFTC PLLT6 

SUPROUTI Np PLTRF6 ( I SYM ,NN ,N$QR , I NCX * I NCY , NSTX » NST Y » NcR F ) 
DIMENSION ISYM( 1 1 ,NBUFFR ( 50) 

DATA NFIAG/O/ 

DATA NFLAG1/0/ 

IF (NFLAG .NF. 0) GO TO 10 
CALL CAMR AV (35) 

CALL BUTT V ( 1 ) 

10 CONTINUE 

IF (NFLAG1 ,NE. 0) GO TO 20 
CALL FRAMFV(O) 

NCOUNT = 0 
INCRXaNSTX 
I NrRYsNSTY 
NFL AG1 =1 

IF (NFLAG .EQ. 0) GO TO 11 

CALL APRNTV ( INCX*INCY*NN*NBUFER*INCRX*INCRY) 

INcRY=INcRY+INCX 

INcRX = INrRX+IAPS( T NrY ) 

NCOUNT =NcOUNT + 1 

11 NFL AG*1 
20 CONTINUE 

ncount=ncount+i 

DO 1 1=1,50 
NRUFFR ( I ) =0 


156 



1 CONTINUE 

ia*o 

DO ? 1*1 »NN 
IB*I A+6 
IC=IB/6 
ID* IB-IC*6 
IE*ID»6 
I A* I A+l 

CALL FLD(NBUFFR( IC) *!F*6» 0,ISYM(l>i 
? CONTINUE 

CALL aPRNTVI lNcX*lNcY*NN*NBUFFR*lNrRX*lNrRY) 
incry*incry+incx 

I NCRX*I NCRX-f I ABS ( INCY) 

IF (INCRX .GF. 1023) NFLAG1=0 

RETURN 

END 


^ORIGIN ALPHA *SYSUT2»RFW 

SIBFTC M0D7 


SUBROUTINE clasfy 


COMMON /LaB1/XbaR(42*12).SIGMa(A 2.12) .ROTt42.12.12) 

COMMON /LA82/X(12),ALPHA(49) ,NsPs,NsCANS,NrHAN,LT9.LTlr,LTl 

1LT13*LT1 *IXXX. IYYY* 

INSTART, NSTOP, 

1 NBTLG»MODE* ITYPE.MSFC* I4,NCRF» 

1 NSK I P * I NfX »IN(*Y*NSTX »NSTY 

namelist/ input7/np a ss,nclust 

NAMELlST/iNPUTA/NSPStNSCANS*NrH* LT 1 ,LT9 , LT 1 0 , L T 1 1 , L T1 2 , LT 

instaRt»nstop,nbtlg»mode»itype*msfc,i4.ncre»nskip,incx*tncy, 

?nsty,ixxx,iyyy 
PQUIVALENCE ( NTH *NrHAN ) 

RPAD(5*INPUT7) 

RFAO (5*1 NPUT A ) 

WRtTF(6.TNPUTA) 

RE AD ( 5 • 1 006 ) ( ALPHA ( I ) f 1 = 1 f 48 ) 

1006 F0RMAT(1X»60A1 ) 

KOUNT=NCLUST 
NSCANS=N SCANS - ! 

INITCL*NCLUST+1 

DO 1 1*1 »NPASS 

CALL TRUCK(NCLUST.NPASS ) 

CALL SEQMRG ( NcLUST *KOUNT * I N I TCL ) 

CALL CLASS (KOUNT , I, NPaSS ) 

nclust*kount 

INITCL*K0UNT+1 
1 CONTINUE 
RETURN 
END 


1 *Lt 


13, 

NSTX 


12 


♦ 


♦ 
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IIRFTr GFTDA7 

SUBROUTINE GET7( DATA*NsPS*NsKiP,NcPw»NSCANO, iRw* IERR,NfLAG? , 
INSTART *NRTLG»MODE»NrRE* I TYPF*M$FC ) 

DTMFNSION DAT A ( 1) *NDAT ( 890) 

DATA NFLAG/0/ 

IF (NFL AG .Nr. 0 ) GO TO 1? 

NSCANOaO 

NTFMP = NCPW* (NCRE-7 ) 

NL=36-NBTLG 

NBLNG=36/NBTLG 

NFLAG=1 

NSTMP=(NSPS+NSTART-1 ) *NCPW+MSEC*1 9 
NSCANS=NSTMP 

NTMPsNSTMP/NBLNG 

NSTMP=NSTMP/NBLN6*NBLNG 

IF (NSTMP .LT. NSCANS) NTMP=NTMP+1 

NSCANS=NTMP 

IF ( NSK I P .EQ. 0) GO TO 402 
DO 401 1 = 1 ♦ NSK I P 

NSCANO=NSCANO+I 
GALL SKRriN ( I RW ♦ ] » RD ) 

401 C0NT1NUF 
40? CONTINUE 
1? CONTINUE 

IF ( NFL AG 2 .FQ. 0) GO TO 10 

13 CONTINUE 

M=(NSTART-1 )*NCPW+MSFC*1 9 
IF (MODE .EQ. 1 ) GO TO 50 

CALL REDTPR ( I RW .MODE ♦ I FRR » NW ♦ NSC ANS » NDAT ) 

GO TO 51 

50 CALL REDTPC ( I RW » MODE * I ERR ♦ NW » N SC ANS ♦ NdAT ) 

51 CONTINUE 

1000 FORMAT ( IX * 16 ) 

NNW=NW*ft 
NFLAG?=0 
NSCANO=NSCANO+l 
10 CONTINUE 

DO 14 NN=1»NCPW 

IRsM+NRLNG 

ID»IR/NBLNG 

I F= I B-NBLNG*I D 

IRITsNBTLG*IF 

M*M+1 

IF ( i TYPr ,FQ« 1 ) GO TO 15 
NDATA=0 

CALL FLD(NDATA»NL»NRTLG»IBIT*NDAT( ID) ) 

DATA(NN)=NDATA 
GO TO 14 
15 CONTINUE 
DATANsO.O 

CALL FLD( DATaN.NL »NRTLG* IB I T.NOATl ID) ) 

DATA(NN)=DATAN 

14 CONTINUE 
m=m+ntemp 
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RETURN 

END 


SIBFTF PL0TT7 

SUbROUTiNf LABFL7 ( NSTaRT ♦NSTOP. iNcRf 
DIMENSION IOUT(1?0) 
NDTF=(NSTOP-NSTART+l ) /IN cRF 
T I *0 

DO 1 I*NSTaRT. NSTOP, INCRE 
11 * 11+1 

IOUT ( 1 1 ) *1 /I 000 

1 CONTINUE 

WRlTF (6*10) ( TOUT ( l ) *I=1 *NdIF) 

11*0 

DO 2 I*NSTART*NSTOP, INCRF 
11 * 11+1 

I0UT( 1 1) *1/100-1/1000*10 

2 CONTINUE 

WRlTF ( 6 » 1 0 ) ( IOUT ( I ) *I*1 *NdIF) 

11*0 

DO B I=NSTART. NSTOP, INCRE 
11 * 11+1 

TOUT ( 1 1 ) = ! /10-T/ 100*10 
1 CONTINUE 

WRlTF (6,10) ( IOUT ( I ) , 1 = 1 ,NDIF ) 

11*0 

DO 4 I*NSTART, NSTOP, INCRE 
11*11+1 

I out ( ii)*i“i/io*io 

IF ( IOUT (II) .LE. 0 ) I OUT ( II ) = 0 
4 CONTINUE 

WRITE (6*10) ( IOUT ( I ) ,I=l,NOTF) 

10 FORMAT MIX, 12011) 

RETURN 

END 


SlBFTr PLLTT7 

subroutine pltrf7(isym,nn,nsQR,iNcx,tncy,nstx.nsty,ncRf, 

1 NFLAG*NFLAG1 ) 

DIMENSION ISYM( 1 ) ,NBUFFR(50) 

DATA NFLG/0/ 

IF (NFLG .NE, 0) GO TO 10 
NFLG*1 

CALL CAMRAV(^S) 

CALL RUTTVU ) 

NS0R*1024/IABS( INCY+INCX) 

10 CONTINUE 

IF ( NFLAG1 .NE. 0) GO TO 20 
CALL FRAMEV(O) 

NCOUNT=0 
INCRX*NSTX 
INCRYaNSTY 
NFLAG1 *1 
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IF (NFLAG .FQ. 0) GO TO 11 

CALL APRNTV < lNcX»TNCY*NN,NRUFFR*TNrRX,lNcRY) 

INCRYxINCRY+INCX 

INcRX=INcRX+IABS( INFY) 

NCOUNTxNCOUNT+1 
11 NFL AGs 1 
20 CONTINUF 

NrOUNTxNCOUNT+l 
DO 1 1=1.50 
NRUFFR( 1 ) =0 

1 CONTINUE 
I A = 0 

DO 7 1=1 .NN.NCRE 

I B= I A+6 

ir= i r/6 

ID=IF-IC*6 

iE=in*6 

I A = I A + 1 

CALL FLD(NBUFFR( TCI * I F*6 » 0»ISYM(I)) 

2 CONTINUF 

CALL APRNTV ( lNrX.lNrY,NN,NRUFFR.lNcRX,lNcRY) 

lNcRY=lNfRY+lNrX 

lNrRX = INrRX+T ARS ( TNrY ) 

IF ( I NCR X .GF. 1024) NFLAG1=0 

RFTURN 

END 


SORIGIN BRAVO , SYSUT 2 »REW 

SIRFTC M 0 D 7 A 

SURROUTlNF TRUrK ( NrcNT.NPASS ) 

DTMFNSION NNACC ( 12 . 256 ) . MTAR ( ll ) ♦ IPRT ( 256 ) * I PLOT ( 2 56 ) 

DIMENSION NTBLUOO ) 

COMMON / LAR 1 / XRAR ( 42 . 12 ) ♦ S I gMa ( 42 . 1 2 ) * ROt ( 42 * 12 . 12 ) 

COMMON / LAB 2 / XU 2 ) , NSYM ( 49 ) , NSPS ♦ NSCANS » NCHAN ♦ LT 9 » LT 10 . LT 1 1 .L T 1 2 , 
1 LT 13 . LT 1 , IXXX . IYYY , 

1 N START .NS TOP , 

lNRTLG.MODF. I TYPF .MSEC . T4.NrRF, 

INSKIP . iNrX . INCY . NSTX.NSTY 
NFLGXX =0 
NFLAGXxO 
REWIND LT 1 1 
REWIND LT 1 
NFL AGl =0 
MET NsO 

IX ! Y = IXXX*IYYY 
DO 10 1 = 1 . I YYY 
MTAR ( I ) = T 
10 CONTINUE 

DO 50 1 = 1 ,400 
NTBL { I ) x I 
50 CONTINUF 

DO 11 1 = 1 » I YYY 

RfaDILTu ) (NNACCt I , JJ ) ,JJ = i , NSPS ) 

MFI N = MFTN +1 
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11 CONTINUE 

NUP=NSPS“I XXX +1 
NCNT.NCCNT+l 
NFLAG*0 
?00 CONTINUE 

III*MTA0(1 ) 

DO HO JJ = l ,NSPS 

IF (JJ .GT. NUP) GO TO 102 

IJ*JJ 

JI.JJ+IXXX-1 
NZERO»0 
I KNT *0 
ISUM.O 
JI J.MTABt 1 ) 

NTFMPs NCCNT+1 
DO 101 IdJ.JI 
DO 100 J I J= 1 » I YYY 
II J«MTAB< JIJ) 

IF ( NNACC ( I I J * I ) .LF. NCCNT .AND. NNACCdlJ.I) .NE. 0) GO TO 102 
IF (NNACCdlJ.I)) 102,107.106 

106 IF (NNACCdlJ.I) .GT. NTFMP) NTFMP=NNACC (I I J ♦ I ) 

GO TO 100 

107 nzfro=nzero+i 

100 CONTINUE 

101 CONTINUE 

IF (NZERO .NE. I X I Y ) GO TO 1 O 5 
DO 101 I=IJ,JI 
DO 104 JI J=1 » I YYY 
NNACC ( J I J » I ) sNcNT 

104 CONTINUE 
101 CONTINUE 

ncnt=ncnt+i 

IF (NCNT .GT. 400) 00 TO 999 
GO TO 110 

105 CONTINUE 

DO 108 I = I J . J I 
DO 108 JI J=1 » I YYY 

IF ( NNACC ( JI J » I ) .FQ. 0) NNACC( JI J.I )=NTFMP 

108 CONTINUE 
GO TO 110 

10? CONTINUF 

no continue 

DO 111 JJ=1,NSP5 

IF (JJ .EQ. NSPS ) GO TO ni 

IF ( NNACC ( 1 1 1 ♦ JJ ) .LE. NCCNT) GO TO 111 

IF (NNACC ( 1 1 1 ♦ JJ+1 ) .LF. NrrNT ) GO TO 111 

IF (NNACC ( 1 1 1 ♦ JJ) .LF. 0) GO TO 111 

IF ( NNACC (III » JJ+1 ) .LE. 0) GO TO 111 

IF (NNACC( 1 1 1 ♦ JJ) .EQ. NNACC ( 1 1 1 .JJ+1 ) ) GO TO 111 

I J«NN ACC (III . JJ) 

JI *NNACC (III.JJ+1) 

IF (JI .GT. 400 .OR. IJ .GT. 400) GO TO 111 
IF (NTBL(JI) ,GT. NTBL ( I J ) ) GO TO l?5 
NTRL(IJ)=NTBL(JI ) 

GO TO HI 
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123 CONTINUE 

NTRL ( JI )=NTBL( ! J) 

HI CONTINUE 
1007 FORMAT ( 1 X * 1 6 ) 

WRiTE(LT1 ) (NNACC( T T I * JJ ) *JJ = 1 *NSPS) 

IF ( MF IN .GE. NSCANS) GO TO 999 
IYTsMTAR ( 1 ) 

read ( lti i ) ( nnacc < i y i *jj) *jj=i *n$ps) 

MFIN.MFIN+1 
NTFMP=MTABU ) 

IYY=IYYY-1 
DO 121 I = 1 * I YY 
MTAB( I ) =MT AB ( ! + l ) 

121 CONTINUE 

MTAR( IYYY J=NTFMP 
GO TO 200 
99R CONTINUE 

DO 172 1=2*1 Y YY 
I I I *MTAB ( I ) 

DO 112 JJ=1*NSPS 

IF (JJ .FQ. NSPS ) GO TO 1 17 

IF ( NNACC ( I I I » JJ ) .LF. NCCNT ) GO TO 11? 

IF ( NNACC (III » J J+l ) .LE. NCCNT) GO TO 112 
IF (NNACC ( I II *JJ) .LF. 0) GO TO 11? 

IF (NNACC ( I I I *JJ + 1 ) .LE. 0) GO TO 112 

IF (NNACC ( I I I *JJ > .FQ. NNACC ( I I I * J J+l ) ) GO TO 112 

I JsNNACC (III *JJ) 

JI=NNACC (III * JJ+1 ) 

IF (JI ,GT. 400 .OR. IJ ,GT. 400) GO TO 112 
IF (NTRL(JI) .GT. NTBLUJM GO TO l?6 
NTRL ( I J) =NTBL ( JI ) 

GO TO 11? 

126 CONTINUF 

NTRL( JI )=NTRL ( I J) 

117 CONTINUE 

WR I TE ( LT 1 ) ( NNACC ( in ,JJ) *jj = l *NSPS) 

177 CONTINUF 

END FILF LTI 

rewind lti 
rfwind lt i i 

REWIND LT 1 2 

WRlTF(6.l007) (NTRL( I ) *1=1 *400) 

DO 113 1=1*400 

IF ( NTBL ( I ) .FQ. 1 ) GO TO 117 
JI=I+1 

IF (NTRL(JT) .NF. I) GO TO 1)4 
NTRL( JI ) = NTBL( I ) 

114 CONTINUE 
117 CONTINUE 
1 1 » 1 

NTFMPal I 
DO 116 1=7*400 

IF (NTRL ( I )-NTrL ( I- l ) ) 117*118*119 
119 IF ( NTRL ( I ) .NF. I) GO TO 117 
NTRL( I-l )=NTFMP 
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11*11+1 
NTEMP*II 
GO TO 116 

118 NT8UI-1 )=NTEMP 
GO TO 116 
117 N.NTRLU) 

NTRL ( I “1 ) sNTFMP 
NTFMP.NTRLtN) 

116 CONTINUE 

NTRL(400)=NTEMP 

WRlTF(6»l 007) (NTRL( I) *1*1 *400) 

LWFR*1 
LOW*NST ART 
70s CONTINUE 

nuppfr=lwfr+i?o-i 

NHI =LOW+l 2 0—1 

IF (NUPPER ,GT. NSPS ) nuppfr=nsps 
idif*nupper-lwer+i 

WR T TE ( 6 *1 00*5 ) 
l00*j FORMAT (1 HI) 

CALL LABEL7 ( LOW.NHI *1 ) 

DO 710 II*1*NSCANS 

RFA0<LT1) (NNACC(1*JJ) *JJ*1 *NSPS) 

00 115 JJ=1*NSPS 
IReNNACC ( 1 *JJ ) 

IE (IS .LE. 0) r,n TO tie 
NNACC(1*JJ)=NTBL(IB) 

115 CONTINUE 

IF (NFLGXX .GT. 0) 0 0 TO 127 

WR I TF ( LT 1 2 ) (NNACC( 1 *JJ) *JJ=1 *NSPS) 

127 CONTINUE 
J I * 0 

DO 711 JJ=LWER»NUPPER 
JI=JI+1 

N*NNACC ( 1 » JJ)-(NNACr( 1 »JJ)-1 )/45*45+2 
I PRT ( J J ) =NSYM ( N ) 

I PLOT (Jl)*NSYM(N) 

711 CONTINUE 

WR|TF( 6 * 1 003 ) II * < fPRT(JJ) * J J = LWfR *NUPP pR ) 
call plt rf7 ( tplot*tote*nblk,incx*iNcy.nstx»nsty* 

1NCRE*NELAGX*NFLAG1 ) 

1003 FORMAT(4X*I6»lH**l?OAl) 

710 CONTINUE 

REWIND LT 1 
NFLAGX*0 
NFLGXX*1 
NFLAG1*0 

lwer=nupper+i 

LOW*NHI-H 

IF (NUPPFR .LT. NSPS ) GO TO 705 
570 CONTINUE 

nccnt=ncnt-i 
END FILE LTl 2 
REWINO LT 1 2 
REWIND LTl 


163 



IXXXd XXX _ 4 
IYYY=IYYY“4 
LT 1 1= 1 3 
RETURN 
END 


SORIGTN RRAVO,SYSUT2*REW 

SIBFTC MOD7R 

SURROUTlNF SrQMRG (N fLUST *KOUNT *]NlTcL ) 

COMMON /LABl/XBAR(42 *12) *SIGMA( 42 *12 ) *ROT (42 *12*12 ) 

COMMON /LAR2/X(12) ♦ALPHA ( 49 ) *NSPS *NSC ANS * NCHAN »LT9 * LT1 0 * LT 1 1 ♦LTl , t 
1LT13.LT1.IXXX.IYYY, 

INSTART. NSTOP, 

1 NBTLG* MODE* I TYPE. MSEC* I4*NCRE* 

INSKIP. INCX*INCY.NSTX*NSTY 

DOUBLE PRECISION A (1 2 * 1 2 ) * EIGEN ( 12 * 12 ) „ 

DIMENSION MERGE (150) *MPOP( 150) »NeXFC(20) *C(A2.78) .B( 12,12) 
DIMENSION C0M(?4) 

EQUIVALENCE ( COM ( 1 ) ,NSPS) 

1000 FORMAT (1X*I6*12F10*3) 

1001 FORMAT (1X.4HXRAR ) 

1002 FORMAT ( IX . 16HDTD NOT cONVERG ) 

1003 FORMAT (1X»7hICLUST= * 1 6 » 1 4hMfRgF ( I CLUST ) = *T6) 

1004 FORMAT (1X.5HRH0* * E 1 5 . 7 . 5HERR= *E15.7) 

1005 FORMAT (1X.12F10.4) 

1006 FORMAT ( IX • 12 I 6 ) 

1007 FORMAT ( IX *23HMERGING WILL TAKE PLACE ) 

1008 FORMAT ( 1 H ) 

1009 FORMAT (13H COV. MATRIX ) 

1010 FORMAT ( 1 2H NORM EIGEN ) 

1011 FORMAT ( 1 8 H P.A. COV. MATRIX ) 

1012 FORMAT ( lH »6HASUM= * F 1 5 . 7 * 7HCLUST FR * I A ) 

1013 FORMAT ( IX *28HXRAR ( I » J) ♦ J = 1 ♦ 12 ) * I = 1 »KOUNT ) 

1014 FORMAT ( IX ,29HSIGMA ( I » J) »J = 1 *12 ) * 1 = 1 »KOUNT ) WT 

1015 FORMAT ( IX »55hROT ( 1 ♦ TCHAN.JCHAN) , JCHAN=1 *12) » ICHAN=1 , 12 ) » I -1 » °j T 

1 ) ) 

1016 FORMAT (1X*I6*( 12F10.3) ) 

1017 FORMAT < 1 H 1 ) 

NFLGsO 

CZFCH=FLOAT(NCHAN)-?.0 

IF (CZECH .LE. 0.0) CZECH=1.0 

REWIND LT 1 0 

REWIND LT 1 2 

RH0=1. 0/(10. 0**5) 

IF (NSKIP .FQ. 0) GO TO 6 

DO 7 1*1 » NSK I P 

CALL SKRBlN(LTlO*l»NOP) 

7 CONTINUE 

6 CONTINUE 
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DO 5 ICLUST=1 .NCLUST 

MER6FUCLUST )*ICLUST 

CONTINUE 

IM=NCHAN 

WR|TF(6*l0l7) 

IN.IM 
I OPT *1 

DO 10 ICLUST=INITCL*NCLUST 
IF (NFLG .GT. 0) GO TO 11 
IF (KOUNT .GE. 42 ) GO TO 11 

kount*kount+i 

CALL^ETCORt IFLAG* c. mpop*nflg*initcl 

WR ! TF ( 6 * 1 00l ) , __ t 

WRITE (6.1 000) IFLAG*<XRAR( I FLAG. I ) » I = 1*12 ) 

MI *1 
M Ja 1 2 

MKal? 

DO 500 MM = 1 * 1 2 M M1 

WR T TF ( 6 *1 000 ) IFLAG * ( C ( I FL AG *MR ) »MR=Ml ,MJ) 

MIeMJ+1 

MJsMJ+MK-MM 

CONTINUE 

CALL AMTRX ( IFLAG*XBAR *C*A »NCHAN ) 

WR I TE ( 6 *1008 ) 

WRI TE ( 6 * 1 009 ) 

WR fTF (6 *1 005 ) < ( AtMI *MJ) *nja u i 

CALL DJCORI { A*lM*TN*lOPT*RHOtERR»EIGEN) 
WRITF<6*1004) RHO.FRR 

WRITE <6 *1005) ( (A(M!*MJ)*MJal*12) *MI=1*12) 

WRITF (6 *1005) C ( EIGFN C Ml *MJ ) *MJ=1*12) .Ml =1*12) 

IF (ERR .EQ. 0.0) GO TO 15 

MERGE ( ICLUST)*0 

KOUNTaKOUNT-1 

WRITE(6*1002) 

GO TO 10 

CALL^OTA ( IFLAG* ROT »EIGEN*NCHAN*A*SIGMA) 
MFRGFUCLUST)=KOUNT 

WRITE ( 6 * 1 003 ) ICLUST*MfRGE( ICLUST ) 

MPOP ( KOUNT ) =MPOP ( I CLUST ) 

IF ( (COUNT .EQ. 1) GO TO 10 

MCLUST=KOUNT-l 

DO 20 ICHFCK=1*20 

NFXEC< ICHFCK)aO 

CONTINUE 

MCHECK=1 

DO 25 JCLUST=1*NCLUST 

IF ( MfRGE ( JCLUST ) .LT.MCHECX )GO TO 25 

MCHECX=MCHECK.+ 1 _ 

IF (MFRGF (JCLUST) .FQ. (COUNT) GO TO 26 

JFLAGaMFRGE ( JCLUST ) 

X° I CHAllh =XBAR < JFLAG * I CHAN ) -XB AR ( (COUNT , I CHAN ) 
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30 CONTINUE 

I FLAG*KOUNT 

CALL KCHFCK ( I FLAG * ROT»X *SIGMa »ASUM, NCHAN ) 

WR I TF ( 6 * 1 008 ) 

WRlTF(6»I 0i2jaSUM,JfLaG 

TF (ASUM .GT. CZECH* GO TO 25 

IFLAG=JFLAG 

CALL KCHECK ( I FLAG * ROT *X»SIGMA* ASUM » NCHAN ) 

WR I TE ( 6 ♦ 1 008 ) 

WRITE(6*1 012) ASUM, JFLAG 
IF (ASUM .GT. CZFCH) GO TO 25 
NFXFC(l)=NEXFCn ) + l 
NSUR=NFXFC( 1 )41 
NFXFC(NSUB)=JFLAG 

25 CONTINUE 

26 IF (NEXEC(l) • FQ , 0) GO TO 10 
DO 501 KK = 1 »NSUB 

WR I TE ( 6 ♦ 1 006 ) KK.NFXEC(KK) 

501 CONTINUF 

MSUPxNEXFCd ) + l 
TOT ALaMPOP ( KOUNT ) 

DO 31 IRUN=2*MSUB 
N SUB«NEX EC ( I RUN ) 

SUMrMPOP ( NSUB ) 

TOTAL=TOTAL+SUM 

31 CONTINUE 
INUMxO 

DENxMPOP (KOUNT) 

DO 35 ICHAN=1 »NCHAN 

X ( I CHAN ) =X BAR (KOUNT 1 1 CHAN ) *DFN/ TOTAL 
DO 40 JCHAN=ICHAN*NCHAN 
INUMxINUM+1 

B ( I CHAN , JCHAN ) =C ( KOUNT ♦ I NUM ) *t>EN /TOTAL 
40 CONTINUE 
35 CONTINUE 

DO 45 IRUN*2»MSUB 
NSUBaNEXEC ( IRUN) 

INUMxO 

DENsMPOP ( NSUB ) 

DO 50 ICHAN=1 tNCHAN 

X(ICHAN)=x < ICHAN)+XBAR(NSUR, ICHAN)*DFN/TOTAL 
DO 55 JCHAN=ICHAN,NCHAN 

inum*inum+i 

R( TCHAN, JCHAN )*B( I THAN • JCHAN ) +C ( NSUB , I NUM )*DEN/TOT AL 
55 CONTINUF 
50 CONTINUF 
45 CONTINUE 

DO 60 ICHAN = 1 .NCHAN 
DO 65 JCHAN = I CHAN * NCHAN 

A< I CHAN* JCHAN )=B( I CHAN ♦ JCHAN ) -X ( I CHAN ) *X ( JCHAN ) 

A( JCHAN *ICHAN)=A( I CHAN, JCHAN) 

65 CONTINUE 
60 CONTINUE 

WRTTF(6*1 009) 

WRl TF (6 ,1005 ) ( ( A (MI *MJ) ,MJ = 1 , 12 ) »MI = 1 , 12 ) 
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CALL DJCOBI (A»IM.IN*I0PT *RhO*ERR* EIGEN) 
WR!TE<6*1 004) RHO*ERR 

WR I TF ( 6 * 1 005 ) ( ( A(MT *MJ ) *MJ = l * 1 2 ) *Ml = 1 . 1? ) 
WRITF(6»1 008) 

WRITE <6* 1005) ( <FIGFN(MI *MJ) *MJ=1 *12 ) *MT =1 * 12 ) 
IF ( FRR *NE. 0.0) GO TO 10 
WR I TF ( 6 *1 007 ) 

IFLAG«NEXEC(2) 

MPOP(IFLAG)«TOTAL 

INUMaO 

DO 70 ICHAN*1 *NCHAN 
XRAR< IFLAG.ICHAN)=XnCHAN) 

DO 75 JCHAN= I CHAN »NCHAN 
1NUM.1NUM+1 

C C IFLAG* I NUM ) =B ( I CHAN * JCHAN ) 

75 CONTINUE 
70 CONTINUE 

CALL ROTA ( iflag*Rot*figen*nchan*a*sigma) 

DO 80 JCLUSTal *NCLU5T 
DO 85 IRUN«?*MSUB 
NSURsNEXFC ( 1RUN ) 

IF < MERGE (JCLUST) ,NE. NSUR) GO TO 85 
MERGE (JCLUST )= IFLAG 
85 CONTINUE 
80 CONTINUE 

Mepce ( ICLUST ) »IFLAG 
IF(NFXECC1)*F0.1 )G0 TO 94 
ISW-O 
JCHECK. 1 

DO 90 JCLUSTal *NCLUST 
IDUM*MERGE< JCLUST ) 

91 IF(MERGE< JCLUST) .LT.JCHFCOGO TO 90 
IF«MFRGE( JCLUST). GT.JCHECX)GO TO 92 
IF< ISW.FQ.l >G0 TO 99 

JCHECK »JCHECK+ I 

I F C JCHFCK.FQ.K0UNT)G0 TO 94 
GO TO 90 

92 MERGE (JCLUST ) =MERGF < JCLUST ) -1 
ISW«1 

GO TO 91 

99 IF (JCHECK .GT. KOUNT ) GO TO 94 
!SW*0 

INUMaO 

MPOP ( JCHECK ) aMPOP ( I DUM ) 

DO 95 ICHAN=1 *NCHAN 

XBAR ( JCHECK » ICHAN ) =XBAR ( I DUM ♦ I CHAN ) 

SI GMA ( JCHECK » I CHAN ) rSI GMA ( I DUM* I CHAN ) 

DO 100 JCHAN= ICHAN *NCHAN 
INUMalNUM+1 

C ( JCHECK * I NUM ) *C ( I DUM , ! NUM ) 

ROT ( JCHECK* ICHAN * JCHAN) =ROT < I DUM* ICHAN* JCHAN ) 
ROT ( JCHECK * JCHAN • I CHAN ) =ROT { I DUM* JCHAN • I CHAN ) 

100 CONTINUE 
95 CONTINUE 

DO 96 LCLUST=1 *NCLUST 
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I F ( MERGE ( LCLUST ) ,NE • I DUM )G0 TO 96 
MERGE ( LCLUST ) = JCHECK 
96 CONTINUE 

JCHECK*JCHECK+1 
90 CONTINUE 

94 KOUNTsKOUNT-NEXEC ( 1 ) 

10 CONTINUE 

11 CONTINUE 

WRITE(LT9) (COM( I) * T=l»24> 

WR I Tp ( LT9 ) <(XraR(T*J)*I=1 .KOUNT ) *J=1.12) 

WR T TF ( LT9 ) ( (SIGMA ( T * J) .1 = 1 .KOUNT ) . J = i ,1? ) 

WR I Tp < LT9 ) ( ( ( ROT (1*1 CHAN * JCHAN ) » I = 1 » KOUNT ) * I CHAN= 1 * N<"hAN ) . 

1 JCHANal t NCHAN ) 

WRlTF(6»lOl3) 

DO 510 1=1. KOUNT 

WR T T F ( 6 . 1 000 ) I . ( XraR ( I »J) *J = 1 .12 ) 

610 CONTINUE 
WRITE(6»1 014) 

DO 511 1=1. KOUNT 

WRlTF(6.l000 ) !,(STC,Ma( I.J),J=l,l?) 

611 CONTTNUF 
WRITF(6*1 015 ) 

DO 512 1=1. KOUNT 

WRlTF<6.1016) I . ( <ROT( I.ICHAN.JCHAN) ,JCHAN=1.12) *ICHAN=1.12 ) 
51? CONTINUE 

DO 513 I=1.NCLUST 

if (Merge ( i > *gt « kount) go to 514 

WRlTF(6.615 ) I .MpRGF ( I ) 

515 FORMAT ( 1X.7HCLUSTER.I4.1X.5HCLASS.I4) 

513 CONTINUF 

514 CONTINUE 

DO 660 1=1. KOUNT 
DO 620 ICHAN=1 .NCHAN 
DO 610 JCHAN=1 .NCHAN 

B< I CHAN. JCHAN )=ROT ( I . JCHAN , I CHAN ) /S IGMA ( I . I CHAN) 

610 CONTINUE 
6 ?0 CONTINUE 

DO 650 ICHAN=1 .NCHAN 
DO 640 KCHAN=1 .NCHAN 
SUMxO.O 

DO 630 JCHAN=1, NCHAN 

SUM=SUM+ROT ( I »ICHAN.JCHAN)*B( JCHAN.KCHAN) 

630 CONTINUE 

A( ICHAN.KCHAN) =sum 
640 CONTINUE 
650 CONTINUE 

WRITE(6.600) I 

600 FORMAT( IX. 13HCLASS FLLIPSF.I4) 

WRtTF(6.1005 ) (<A(TA»JA).JA=1 .NCHAN) ♦ TA=1 .NCHAN ) 

660 CONTINUE 

REWIND LTQ 

RETURN 

END 
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JIBFTF GFTCOR 

subroutine fetcori iflag.c.npop.nflg.n ) 

COMMON /LAB1/XbaR<42»12) *SIGMA(42.12) .ROTI42.12.12) 

COMMON /LAB2/XI 12) *ALPHA(49) *NSPS»NSCANS*NchaN,LT9»LT10*LT11 ,LT12* 
1LT13»LT1 »IX»IY. 

INSTART. NSTOP, 

1NRTLG.M0DE.ITYPE.MSFC.I4.NCRE. 
lNSK|Pf|NcX.|NCY#NSTX»NSTY 
DIMENSION NPOP(l)»C(42*78) *NDAT<255) 

DATA NCNT/O/ 

INUM»0 
NFLGl *0 
NFLG5*0 

DO 5 ICHAN=1 *NCHAN 
XBAR( IFLAG»ICHAN)=0.0 

DO 10 jchanmchan.nchan 

I NUM= I NUM+1 
C( IFLAG*lNUM)*0.0 
10 CONTINUE 
5 CONTINUE 
KNT*0 

40 CONTINUE 

IF (NCNT .GF. NSCANS) GO TO 70 
NFLG?*0 

READILTi? ) (NDAT( JJ) » J J=l »NSPS ) 

NrNT.NrNT+1 

NFLGl*! 

NFLAG2=1 

DO 20 JJ=1,NSPS 

CALL GET 7 (X(l),NSPS*0*NcHAN*NSCANO,LTlO f TFRR.NFLAG2, 

INSTART tNBTLG*MODF*NcRE* I TYPF*MSFC ) 

IF (NDAT(JJ) .NE. N) GO TO 30 
KNT=KNT + 1 
NFLG2=1 
AI =FLOAT ( KNT ) 

IN(JM=0 

DO 25 I CHAN=1 »NCHAN 

XBAR( I FLAG. ICHAN)=( 1. 0-1.0 /A I ) *XBAR ( I FLAG. I CHAN ) +X ( I CHAN ) /AT 
DO 26 JCHAN = I CHAN *NCHAN 
I NUM= I NUM+1 

C( I FLAG. INUM) = { 1.0-1.0/AI ) *C ( I FL AG . I NUM ) +X ( I CHAN ) *X < JChAN ) / A I 
26 CONTINUE 
25 CONTINUE 
GO TO 20 
50 CONTINUE 

IF (NFLG5 .FQ. 1) GO TO 20 
IF (NDAT(JJ) .NF. N+l ) GOTO 20 

nsav*ncnt 

NFLG5=1 
20 CONTINUF 

C WR ITF ( 6 ♦ 1 000 ) NcNT.KNT.NSAV*NBCXUP*N t NFLG2.NFLG' : » 

1000 FORMAT ( 1 X » 7 1 8 ) 

IF ( NFLG2 .NF. 0) GO TO 40 
IF ( NFLG5 .FQ. 0) GO TO 40 
NRCKUP=NCNT-NSaV+1 
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CALL BSRPCD(LT10,NRCKUP*I4»RF) 

CALL BSRFCD(LTl2»NBCKUP»RF) 

NCNT *NSAV“1 

NPOP ( N ) =K NT 

NsN+1 

RFTURN 

70 CONTINUF 

RFWIND L T 1 0 
REWIND LT 1 7 
NFLG= 1 
RFTURN 
FND 


SIBFTF TRXAM 

SURROUTINF AMTRX ( iflag»xbar»c* A*NCHAN ) 

DIMENSION XRAR(42*12> *C(42*78) 

DOUBLF PRECISION A ( 12*1?) 

I NUMsO 

DO 1 ICHANrl ♦NCHAN 
DO ? JCHAN=ICHAN* NTH AN 
I NUMsc I NUM+ 1 

A ( I CHAN* JCHAN )=C ( I F|_AG ♦ I NUM ) -XBAR ( I FLAG* ICHAN)*XBAR( IFlAG*JCHAn 
A( JCHAN* ICHAN ) = A ( 1 CHAN* JCHAN) 

2 CONTINUF 

I CONTINUF 

RFTURN 
FND 


SIRFTC ATOR 

SUBROUTINE ROT A ( I FL AG *ROT * FI GEN , NCHAN » A » S TGMA ) 
DIMENSION ROT ( 47 » 12 * 1 2 ) 

DIMENSION SIGMA (42*12) 

DOUBLF PRFCISION A(1?*1?) 

DOUBLE PRFCISION FIGFN(12*1?) 

DO I I CH A N = 1 ♦ NCHAN 
S I GM A ( I FLAG* !CHAN)=A ( I CHAN* I CHAN) 

DO ? JCHAN = I » NCHAN 

ROT < I FLAG * ICHAN* JCHAN )=E I GEN (JCHAN* ICHAN ) 

7 CONTINUF 

1 CONTINUF 

RFTURN 
FND 


SIRFTF XCEHCK 

SUBROUTINE K.CHFCK (IFLAG* ROT*X*SIGMa*ASUM, NCHAN) 

DIMENSION ROT (42*12*12) * SIGMA ( 42 » 1 2 ) *X( 1 ) 
asum=o « 0 

DO R I CHAN=1 *NCHAN 
BliMsO.O 

DO 4 JCHAN = 1 * NCHAN 

SUM = SUM+ROT( I FLAG* I CHAN* JCHAN )*X( JCHAN) 

4 CONTINUF 
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ASUM=aSUM+SUM*SUM/$iGMa< I flag* ICHAN) 
3 CONTINUE 
RETURN 
END 


SORIGTN BRAVO»SYSUT2*REW 

SlRFTf M0D7C 

SUBROUTINE class<nclass»ntest »npass ) 

COMMON /LAB1/XraR(42»12) ♦SIGMa(42*12) ♦ROt ( 42 ♦ 12 * 1 2 ) 

COMMON /LAR2/X( 12)f ALPHA(49) ♦NSPS*NSCANS,NchaN,LT9*LT10.LT11 ,LT12, 
1LT13,LT1 *IX*NDUMMY* 
iNSTART, nstop, 

1NpTLC,»MODE» ITYPF»MSFC*I4.NcRF, 

INSKIP* INCX *INCY.NSTX*NSTY 
DIMENSION W ( 1 2 ) *MTAP ( 3 ) 

DIMENSION NDAT (255*3) »PRNT (255) 

DIMENSION COM ( ?4 ) 

FQUIVALeNCE(COM{ l ) ,NSPS) 

REWIND LT9 
REWIND LT 1 0 
RFWIND lti 
rewind LT 12 
Rewind LTI3 
NELAGl =0 
LTI *1 

IF (NPaSS .Ne. NTEST) LT ] = LT 1 3 
CZFCH=NCHAN 

IE CNSKTP ,E0. 0) GO TO 601 

DO 602 I *1 *NSKlP 

CALL SKRRlN(LTlO,itNOP) 

60? CONTINUE 
601 CONTINUE 

RFAD(LT9) (COM(I) *1=1*24) 

RFADfLTo ) (<XbaR<T*J)»T = 1 *NcLaSS) » J = i ,1 2 ) 

RF4D(LT<n ( (Sigma ( r *i=i » nclass) »j=i*12> 

RFAD(LT9 ) ( ( (ROT ( I , ICHAN, JrHAN) ♦ 1 = 1 ,NCLASS) * I CHAN= 1 » NCM AN ) * 

1 JCHAN=1 *NCHAN ) 

DO 1 1=1,3 
1 MT AB 1 1 ) = I 

DO io iend=i ,nscang 

Read ( lti 2 ) cndati i * 1 > ,i=i ,nspsj 

NELAG2=1 

DO 20 I SUBNsl ,NSPS 

CALL GFT7(X(1 ) *NSPS,0,NchaN,NSCANO,LT1O, TFRR,NeLAG 2, 
1NSTART,NRTLG»M0DE*NrRE,ITYPF,MSFC ) 

IF (NDAT( TSUpN,1) .gT. 0 ) NdaT( isurn.i )= 0 
SMALL=l,75*CZECH 
DO 26 I CLASS= 1 ,NCLASS 
DO 30 ICHAN=1 ,NCHAN 

W( TCHAN) =X ( ICHAN )-XfaR( ICLASS * ICHAN) 

30 CONTINUE 
A c UM=0 # 0 

DO 36 ICHAN = 1 * NCHAN 
SUM=0.0 
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DO 40 JCHAN=1 .NCHAN 

SUM=SUM+W( JCHAN)*ROT( ICLaSS. ichan» JCHAN ) 

40 CONTINUE 

41 ASUM=aSUM+SUM*SUM/STGMa ( T CLASS ♦ T CM an ) 

8 A CONTINUE 

IF (ASUM .GT. SMALL) GO TO 25 
small=asum 

NDATI lSUpN,l )=ICLASS 
?5 CONTINUE 
1016 FORMAT (IX ♦ 3 1 6 * F 1 0.2) 

20 CONTINUF 

WRtTf(LT1 ) (N0AT( I ♦! ) *1=1 ,NSPS) 

10 FONTINUF 

FND FILE L T 1 
REWIND LT1 
REWIND LT1 2 
REWIND LT 1 0 

IF (NPASS .Ne. NTFST) GO TO 804 
DO 610 I Z = 1 .NSCANS 
IY=MTAB( 1 ) 

RFAD(LTl) ( ND AT ( TA*lY ) ♦! A = 1 ♦ NSPS ) 

ntfmp=mtab ( 1 ) 

MTAB< 1 )=MTAR( 2 ) 

MTAP(2)=MTAR(8) 

MTAB(R)=NTEMP 

IF ( IZ .LT . 8 ) GO TO 61 0 

DO 620 IA=NSTART.NgtOP 

IE ( TA .EQ. 1 ) GO TO 620 

IE (IA+1 .GT. NSTOP ) GO TO 6?0 

I TY=MTAR ( 2 ) 

I M=MT AB ( 1 ) 

I N=MTAB ( 2 ) 

M=NDAT( I A * I M > 

N=NDAT ( I A — 1 ♦ IN) 

IF (M ,NF • N) GO TO 650 
IL=MTAR( 8 ) 

L=NDAT ( t A ♦ I L ) 

IF (M .NE • L) GO TO 650 
NDAT( I At I IY)=M 
GO TO 620 
650 I M = MT AB ( 1 ) 

M = NDAT ( I A — 1 ♦ I M > 

!N=MTAB( 8 ) 

NaNDAT ( T A — 1 .IN) 

IF (M .NP. N) GO TO 620 
L =NDAT ( T A + 1 ♦ T M ) 

IF (M .NE. L) GO TO 620 
NOAT ( I A* I I Y ) =M 
620 CONTINUE 

IF ( IZ .LT. 8 ) GO TO 610 
L = MT AR ( 1 ) 

WR T Tf ( LT 1 8 ) ( NoaT ( T ,L ) * 1 = 1 .NSPS) 

6 1 0 GONTTNUF 

00 611 1=2*2 
L = MT AR ( 1 ) 
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WRtTc(LTi^) <NdAT( TL.L) t!L»l,NSPS) 

Ml CONTINUE 
R04 CONTINUE 

REWIND LT 1 
REWIND LT9 

rewind lti? 

Rewind LTl 0 
LOW«NSTART 
LWERa 1 

ROO CONTINUE 

NHI =LOW+1 ?0-l 
NUPPERsLWER+1 ?0-1 

IE (NUPPFR .GT. NSPS ) NUPPER=NSPS 

IDTF=NUPPER-LWER+1 

WR I TE ( 6 * 1 00? ) 

1007 FORMAT ( 1 HI ) 

CALL LABEL7(L0W*NHI ♦! ) 

DO ROT 11=1 *NSCANS 

READ (LTl** ) (NDAT( JJo ) ,JJ =1 ,NSPS) 

DO 80? JJ=LWER»NUPPeR 
!B=NdaT( JJ. l ) 

IRND=IB-( IB-1 ) /4R*4*i+7 
PRNT ( JJ ) =ALPHA ( I RND ) 

80? CONTINUE 

-f.l. LI :. PLT ? F7 <PRNT(LWFR, * ,DIF * NBLK ’ lN CX,lNcY,NSTX,NSTY,NcRE, 
1 NFLAGX t NF LAG I J 

WR I Tp ( 6 * 1 008 ) II. (PRNT( JJ) ,JJ=LWER.NuPPeR) 

100R FORMAT ( 4X * 1 6 * lH* * 1 ?0A 1 ) 

801 CONTINUE 

REWIND LTl 3 
NELAG1=0 

nflagx=o 
LWER»NUPPER+1 
LOW=NHI +1 

IF (NUPPER .LT. NSPS ) GO TO ROO 
RO? CONTI NUE 

nscans=nscans-7 

return 

END 
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